Hi expert...
Im newbie in access and in this forum too.., so i have a problem. Maybe this is simple problem. I have excel file with name printExcel.xls and sheet name = dataSoure. I want to export data to specific sheet. I already create a function to export data from access (by query) to excel, but it doesnt work properly.
Currently, i can get data fields from dataSource sheet and combine it to create insert query. But when i want to execute that query, its doesnt work...
This is my code:
Code:
Public Sub ConnectToExcelUsingSheetName(fileName As String, dataSourceName As String, query As String)
On Error GoTo ConnectToExcelUsingSheetName_Err
Dim cnn As New ADODB.Connection
Dim cnn1 As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim rst1 As New ADODB.Recordset
Dim arrData() As Variant
Dim valueStr As String
Dim insertQuery As String
'get field from excel sheet
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source='" & fileName & "';" & _
"Extended Properties=""Excel 8.0;HDR=YES"";"
rst.Open "SELECT * FROM [" & dataSourceName & "$];", cnn, adOpenStatic, adLockReadOnly
Dim XlField As String
For i = 0 To rst.Fields.Count - 1
XlField = XlField + rst.Fields(i).Name + ","
Next i
XlField = Left(XlField, Len(XlField) - 1)
'get value from query
Set cnn1 = CurrentProject.Connection
rst1.Open query, cnn1, adOpenDynamic, adLockOptimistic
'Read the Excel recordset into a variant array
arrData = rst1.GetRows(rst1.RecordCount)
valueStr = ""
For i = 0 To rst1.RecordCount - 1
For x = 0 To rst1.Fields.Count - 1
valueStr = valueStr + "'" + Replace(Nz(arrData(x, i), ""), "'", "^") + "',"
Next x
If valueStr <> "" Then
valueStr = Left(valueStr, Len(valueStr) - 1)
insertQuery = "Insert into [" & dataSourceName & "$] (" & XlField & ") values (" & valueStr & ")"
'maybe this is main problem
cnn.Execute insertQuery
'rst1.Open insertQuery, cnn
End If
Next i
MsgBox "File has been created."
ConnectToExcelUsingSheetName_Exit:
cnn.Close
cnn1.Close
rst.Close
rst1.Close
Set cnn = Nothing
Set rst = Nothing
Set cnn1 = Nothing
Set rst1 = Nothing
Exit Sub
ConnectToExcelUsingSheetName_Err:
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
Resume ConnectToExcelUsingSheetName_Exit
End Sub
im sorry if problem like this already exist and already solved.
thx