Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations derfloh on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How to copy or transfer data from several excell sheets to access tabl

Status
Not open for further replies.

gglgokop1704

Programmer
Aug 9, 2007
54
GB
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
 
A minor change, from

DoCmd.TransferSpreadsheet acImport, , "MultiSheet_Example", "C:\Documents and Settings\a99858\My Documents\P2001.xls", -1, "objExcel.Application.activeworkbook.worksheets.Name(i)!A2:E8"

to this

DoCmd.TransferSpreadsheet acImport, , "MultiSheet_Example", "C:\Documents and Settings\a99858\My Documents\P2001.xls", -1, objExcel.Application.activeworkbook.worksheets.Name(i) & "!A2:E8
 
Dear Jerry,

Thanks a lot. It still does not produce the "Multisheet_Example" access table. Though it did not give any errors. Am I doing the looping incorrectly?. Or may be the objExcel.Application.activeworkbook.worksheets.Name(i) is not holding the worksheets in the work book. Should I opened the workbook first?

Thanks again for your help
 

Would this work?

DoCmd.TransferSpreadsheet acImport, , "MultiSheet_Example", "C:\Documents and Settings\a99858\My Documents\P2001.xls", -1, "Sheet(" & objExcel.Application.activeworkbook.worksheets.Name(i) & ")!A2:E8"


 
Thanks again for your time Jerry. It did not produce the access table, however there was no error. It ran well. I even tried tinkering with --- worksheets.Name(i) to --- worksheets(i).Name, I mean the (i) in "Sheet(" & objExcel.Application.activeworkbook.worksheets.Name(i) & ")!A2:E8"

I have spent two days on this single line.

I appreciate your efforts.

Kind regards and thanks
Gokop
 
Thanks again for your time Jerry. It did not produce the access table, however there was no error. It ran well. I even tried tinkering with --- worksheets.Name(i) to --- worksheets(i).Name, I mean the (i) in "Sheet(" & objExcel.Application.activeworkbook.worksheets.Name(i) & ")!A2:E8"

I have spent two days on this single line.

Guess what, when I put one of the names of the worksheets , GL001 in DoCmd.TransferSpreadsheet acImport, , "MultiSheet_Example", "C:\Documents and Settings\a99858\My Documents\P2001.xls", -1, GL001!A2:E8, it produced the access table 2 times. This means that the syntax is correct, but how to get the objExcel to hold the value names of the worksheets is the problem. Almost there I guess.


I appreciate your efforts.

Kind regards and thanks
Gokop
 
Dear all,

Please how can I loop through the worksheets of a workbook in excel using

For Each <worksheet> In <WorkBook> command to coppy data from one work sheet one afeter another to a single access table? I am using the TransferSpreadsheet method in VB.

Any idea or code is appreciated

Kind regards
 
Ok! Once more
Code:
Private Sub Command5_Click()

Dim bIsXLCreated As Boolean
Dim objExcel As Object
Dim objWkBook As Object
Dim objWkSheet As Object
Dim strPath As String
Dim strWkBookName As String


strPath = "C:\Documents and Settings\a99858\My Documents\"
wkBookName = "P2001.xls"
strWkBookName = strPath & wkBookName


On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number = 0 Then
   bIsXLCreated = False
Else
   Set objExcel = CreateObject("Excel.Application")
   bIsXLCreated = True
End If


Set objWkBook = objExcel.Workbooks.Open(strWkBookName)
For Each objWkSheet In objWkBook 
   DoCmd.TransferSpreadsheet acImport, , "MultiSheet_Example", strWkBookName , -1, "Sheet(" & objWkSheet.Name & "!)A2:E8"
Next i


Set objWkBook = Nothing
objExcel.Quit
Set objExcel = Nothing

End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top