gglgokop1704
Programmer
Dear All,
Please how can I programmatically used the TrasnferSpreadshet method in vb to copy several excel worksheets from a workbook (excel file) to a single acces table. I almost got, but got stuck. See the code below:
Private Sub Command5_Click()
'booXLCreated As Boolean
Dim objExcel As Object
Dim objActiveWkBook As Object
Dim objActiveWkSheet As Object
Dim objExcelFrontEnd As Object
Dim sheetName As String
Dim sheetRange As String
Dim GLCodeSField, CostCentreCodeField As Field
Dim wkBookName As String
Dim strPath As String
Dim strWkBookName As String
Dim wkSheetName As String
Dim noWkSheet As Integer
Dim wkSheetCount As Integer
Dim i As Integer
strPath = "C:\Documents and Settings/a99858/My Documents/"
wkBookName = "P2001.xls"
strWkBookName = strPath & wkBookName
noWkSheet = 0
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number = 0 Then
booXLCreated = False
Else
Set objExcel = CreateObject("Excel.Application")
booXLCreated = True
End If
'Dim CaseValue As Integer
'If Len(Dir(strWkBookName)) > 0 Then
'CaseValue = 1
'Else
'CaseValue = 2
'End If
'Select Case CaseValue
'Case 1
Set objExcelFrontEnd = objExcel.Workbooks.Open(strWkBookName)
Set objActiveWkBook = objExcel.Application.activeworkbook
noWkSheet = objActiveWkBook.worksheets.count
'Dim ReturnValue As Integer
For i = 1 To noWkSheet
'ReturnValue = StrComp(wkSheetName, objExcel.Application.activeworkbook.worksheets(i).Name)
'If ReturnValue = 0 Then
'objExcel.Application.activeworkbook.worksheets(wkSheetName).Select
'objActiveWkBook.worksheets(i).select
'sheetName = "objExcel.Application.activeworkbook.worksheet(i).Name"
'sheetRang = "A2:E8"
objExcel.Visible = True
'i = noWkSheet
'End If
DoCmd.TransferSpreadsheet acImport, , "MultiSheet_Example", "C:\Documents and Settings\a99858\My Documents\P2001.xls", -1, "objExcel.Application.activeworkbook.worksheets.Name(i)!A2:E8"
Next i
'If ReturnValue <> 0 And i >= noWkSheet Then
'End If
'End Select
'DoCmd.TransferSpreadsheet acImport, , "MultiSheet_Example", "C:\Documents and Settings\a99858\My Documents\P2001.xls", -1, "GL001!A2:E8GL002!A2:E8GL003!A2:E8"
'DoCmd.RunSQL "ALTER TABLE MultiSheet_Example ADD COLUMN GCode INT, GMonth DATE", -1
End Sub
Any help is appreciated
Please how can I programmatically used the TrasnferSpreadshet method in vb to copy several excel worksheets from a workbook (excel file) to a single acces table. I almost got, but got stuck. See the code below:
Private Sub Command5_Click()
'booXLCreated As Boolean
Dim objExcel As Object
Dim objActiveWkBook As Object
Dim objActiveWkSheet As Object
Dim objExcelFrontEnd As Object
Dim sheetName As String
Dim sheetRange As String
Dim GLCodeSField, CostCentreCodeField As Field
Dim wkBookName As String
Dim strPath As String
Dim strWkBookName As String
Dim wkSheetName As String
Dim noWkSheet As Integer
Dim wkSheetCount As Integer
Dim i As Integer
strPath = "C:\Documents and Settings/a99858/My Documents/"
wkBookName = "P2001.xls"
strWkBookName = strPath & wkBookName
noWkSheet = 0
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number = 0 Then
booXLCreated = False
Else
Set objExcel = CreateObject("Excel.Application")
booXLCreated = True
End If
'Dim CaseValue As Integer
'If Len(Dir(strWkBookName)) > 0 Then
'CaseValue = 1
'Else
'CaseValue = 2
'End If
'Select Case CaseValue
'Case 1
Set objExcelFrontEnd = objExcel.Workbooks.Open(strWkBookName)
Set objActiveWkBook = objExcel.Application.activeworkbook
noWkSheet = objActiveWkBook.worksheets.count
'Dim ReturnValue As Integer
For i = 1 To noWkSheet
'ReturnValue = StrComp(wkSheetName, objExcel.Application.activeworkbook.worksheets(i).Name)
'If ReturnValue = 0 Then
'objExcel.Application.activeworkbook.worksheets(wkSheetName).Select
'objActiveWkBook.worksheets(i).select
'sheetName = "objExcel.Application.activeworkbook.worksheet(i).Name"
'sheetRang = "A2:E8"
objExcel.Visible = True
'i = noWkSheet
'End If
DoCmd.TransferSpreadsheet acImport, , "MultiSheet_Example", "C:\Documents and Settings\a99858\My Documents\P2001.xls", -1, "objExcel.Application.activeworkbook.worksheets.Name(i)!A2:E8"
Next i
'If ReturnValue <> 0 And i >= noWkSheet Then
'End If
'End Select
'DoCmd.TransferSpreadsheet acImport, , "MultiSheet_Example", "C:\Documents and Settings\a99858\My Documents\P2001.xls", -1, "GL001!A2:E8GL002!A2:E8GL003!A2:E8"
'DoCmd.RunSQL "ALTER TABLE MultiSheet_Example ADD COLUMN GCode INT, GMonth DATE", -1
End Sub
Any help is appreciated