I am using Access 2010 and Excel 2010. I need to have VB script to export the access table 502 records by 38 fields into Multiple Excel workbooks each having multiple tabs. In the Access table each record has two fields: Div and Tab that will be used to name each workbook and each tab (sheet). There are 6 unique "Div"'s to name the 6 workbooks and there are several "Tab" names for each Div (workbook).
Excel workbooks would take names from the "Div" field and the tab names would come from the "Tab" field in the Access table. First need to find workbook name (Div - Field) then the look for each sheet name (Tab - Field) to create 1st Excel workbook with all the sheets (Tab) and repeat the process. I think you need to approach of read the Access table one record at a time keying on the "Div" and "Tab" fields in creating each Excel workbook with the associated multiple tabs (sheets) that are written to a common folder.
Note: These 6 workbooks with multiple tabs were originally imported into Access from one common folder on my desktop by this routine.
Option Compare Database
Option Explicit
Private Sub Command1_Click()
Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPath As String, strTable As String
Dim strFile As String
Dim strPAF As String
Dim strPassword As String
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True
' Replace C:\Filename.xls with the actual path and filename
Baseline\test3\"
strPath = Me.myFileName
strFile = Dir(strPath & "*.xlsx")
' Replace tablename with the real name of the table into which
' the data are to be imported
strTable = "Table 1"
' Replace passwordtext with the real password;
' if there is no password, replace it with vbNullString constant
' (e.g., strPassword = vbNullString)
strPassword = "password"
blnReadOnly = True ' open EXCEL file in read-only mode
Do While Len(strFile) > 0
strPAF = strPath & strFile
' Open the EXCEL file and read the worksheet names into a collection
Set colWorksheets = New Collection
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
Set objWorkbook = objExcel.Workbooks.Open(strPAF, , , , _
strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount
' Close the EXCEL file without saving the file, and clean up the EXCEL objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing
' Import the data from each worksheet into the table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, 10, strTable, strPAF, blnHasFieldNames, colWorksheets(lngCount) & "$"
Next lngCount
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPAF
strFile = Dir()
' Delete the collection
Set colWorksheets = Nothing
Loop
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPAF
End Sub
Any help would be greatly appreciated.
Thank you.