workbook to access

[jnewl]

i have several workbooks that have multi tabs. i need to generate a workbook
for each tab, so that i can import the books to access to build a master
table. the tabs are different in each excel workbook. therefore, i would like
to generate standard names when extracting each tab. for example, tab 1 would
be stdbook1, tab 2 would be stdbook2. that way i can build an append query
in access that will take each standard name and load to a master table,
regardless of original name in excel.

i got this code from an earlier request:

Sub createbk()
Dim wks As Worksheet
Dim wbkNew As Workbook
Dim lng As Long

lng = 1
For Each wks In ThisWorkbook.Worksheets
wks.Copy
Set wbkNew = ActiveWorkbook
wbkNew.SaveAs ThisWorkbook.Path & "\stdBook" & lng & ".xls"
wbknew.close
lng = lng + 1
Next wks

End Sub

the problem is only takes the first tab and stops.

plus i can not control the path

so i tried something like this:

placed a dim statement above - dim path as long

then in the wks.copy section had
path = "G.\master folder\build access table"

then kept the rest of the code.

that did not work.


i tried building vb code in access to take each tab from the workbook and
then import but that did not work, so i went the above route.

so. how do i get it so it will go past the first tab and how do i build the
path for the output location

thanks much

 

[Dave Peterson]

I'm not sure why it stopped after one sheet. Your code worked for me.

Option Explicit
Sub Createbk()
Dim wks As Worksheet
Dim wbkNew As Workbook
Dim lng As Long
Dim myPath As String

myPath = "C:\my documents\excel\test" '<-- change this
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

lng = 1
For Each wks In ThisWorkbook.Worksheets
wks.Copy
Set wbkNew = ActiveWorkbook
wbkNew.SaveAs myPath & "stdBook" & lng & ".xls"
wbkNew.Close savechanges:=False
lng = lng + 1
Next wks

End Sub

But watch out for typos here:

mypath = "G.\master folder\build access table"

That dot should be a colon and that folder has to exist on the drive.

 

[jnewl]

thanks for your help. i had a colon in the code. i rekeyed when i sent to
you and did not put the colon
i will try the code again with the path and see what happens

 

[jnewl]

i am not sure how it is working because in office 2007 it stops at the first
tab. the workbook is stdbook1. however, when i try to open the book, i get an
error indicating possible corruption and work file extension.
i changed the extension to xlsx and could open the book, but no data was
posted.

so, something is still not correct. i made a very simple file to test this.
the book had 4 tabs labelled 010, 020, 030, 040. keyed a few records for each
sheet.
when it ran, the code looks as though it works, but when go to review the
results, have only stdbook1. do not have stdbook2, stdbook3 and stdbook4, as
well.

stdbook1 did not have any data.

this is rather critical because i am trying to validate a lot of information
and need to send to access to do that.

thanks

 

[Dave Peterson]

Take a look at Ron de Bruin's site.
http://www.rondebruin.nl/saveas.htm

And include the code that specifies the fileformat (along with the extension you
want).

 

[jnewl]

i don't see any difference in the code vs what i have, other than the format
numbers.
if i do a macro, the data is copied. but that defeats the purpose because
then i have to go and change the macro everytime,.

 

[keiji kounoike]

I'm not sure whether this would work or not in your case. but try this one.
copy the code to a new workbook's module, and then open your test file
in the same Excel object.

Sub createbk()
Dim wks As Worksheet
Dim wbkNew As Workbook, srcbk As Workbook
Dim wkbk As Workbook
Dim lng As Long

lng = 1
For Each wkbk In Workbooks
If Workbooks.Count > 2 Then
MsgBox "More than 2 Workbooks are opened" & Chr(10) & _
"Only two workbooks need to be opened"
Exit Sub
ElseIf Workbooks.Count = 1 Then
MsgBox "Can't find a Databook" & Chr(10) & _
"Open the Excel Databook in the same Application"
Exit Sub
Else
If Not wkbk Is ThisWorkbook Then
Set srcbk = wkbk
End If
End If
Next

If srcbk Is Nothing Then
MsgBox "Unkown error: can't set object"
Exit Sub
End If

For Each wks In srcbk.Worksheets
wks.Copy
Set wbkNew = ActiveWorkbook
wbkNew.SaveAs ThisWorkbook.Path & "\stdBook" & lng & ".xls"
wbkNew.Close
lng = lng + 1
Next wks

End Sub

keiji

 

[jnewl]

that did it!! thank you much

I'm not sure whether this would work or not in your case. but try this one.
copy the code to a new workbook's module, and then open your test file
in the same Excel object.

Sub createbk()
Dim wks As Worksheet
Dim wbkNew As Workbook, srcbk As Workbook
Dim wkbk As Workbook
Dim lng As Long

lng = 1
For Each wkbk In Workbooks
If Workbooks.Count > 2 Then
MsgBox "More than 2 Workbooks are opened" & Chr(10) & _
"Only two workbooks need to be opened"
Exit Sub
ElseIf Workbooks.Count = 1 Then
MsgBox "Can't find a Databook" & Chr(10) & _
"Open the Excel Databook in the same Application"
Exit Sub
Else
If Not wkbk Is ThisWorkbook Then
Set srcbk = wkbk
End If
End If
Next

If srcbk Is Nothing Then
MsgBox "Unkown error: can't set object"
Exit Sub
End If

For Each wks In srcbk.Worksheets
wks.Copy
Set wbkNew = ActiveWorkbook
wbkNew.SaveAs ThisWorkbook.Path & "\stdBook" & lng & ".xls"
wbkNew.Close
lng = lng + 1
Next wks

End Sub

keiji

 

[keiji kounoike]

you're welcome.

keiji

that did it!! thank you much