Hi Guys,
Anyone who can help me how to transfer multiple tables from Access to Excel with specific file name and sheet name into a single workbook only? The code works fine for exporting a singe table but the code stops at "Set xlSheet1"
'SET UP EXCEL
Dim FilePath As String
Dim FileName As String
Dim SheetName1 As String
Dim SheetName2 As String
Dim xlApp As Object
Dim xlWorkbook As Object
Dim xlSheet1 As Object
Dim xlSheet2 As Object
Set xlApp = CreateObject("Excel.Application")
'SETTING FILE PATH AND SHEET NAME
FilePath = "C:\users" & CDS_ID & "\Desktop\DATAMART\POTENTIAL HIGH AGEING PART STATUS" & Plant_Code.Value & " - Potential High Ageing - " & Format(Date, "dd") & "-" & Format(Date, "mmm") & "-" & Format(Date, "yy") & ".xls"
SheetName1 = "_" & Plant_Code.Value & "_PART STATUS"
SheetName2 = "_" & Plant_Code.Value & "_POTENTIAL HIGH AGEING"
FileName = Plant_Code.Value & " - Potential High Ageing - " & Format(Date, "dd") & "-" & Format(Date, "mmm") & "-" & Format(Date, "yy") & ".xls"
'CHECK IF FILE IS OPEN
Dim Ret
On Error Resume Next
Ret = IsWorkBookOpen(FilePath)
If Ret = True Then
MsgBox FileName & " is open. Please close it first.", vbExclamation, "File is OPEN"
Exit Sub
Else
End If
'DELETE EXISTING FILE
On Error Resume Next
If Dir(FilePath) <> "" Then
Kill (FilePath)
Else
End If
On Error GoTo 0
'RUN QUERY
Dim stDocName As String
stDocName = "High Ageing Part Status"
DoCmd.RunMacro stDocName
DoCmd.TransferSpreadsheet 1, 9, "tbl_Part_Status", FilePath, , SheetName1
DoCmd.TransferSpreadsheet 1, 9, "tbl_Part_Status", FilePath, , SheetName2
'EXCEL FILE
Set xlWorkbook = xlApp.Workbooks.Open(FilePath)
Set xlSheet1 = xlWorkbook.Worksheets(SheetName1) ==> Error starts here
Set xlSheet2 = xlWorkbook.Worksheets(SheetName2)
xlApp.Visible = True
xlApp.Windows(FileName).WindowState = -4137
xlApp.DisplayAlerts = False
xlSheet1.Select
Anyone who can help me how to transfer multiple tables from Access to Excel with specific file name and sheet name into a single workbook only? The code works fine for exporting a singe table but the code stops at "Set xlSheet1"
'SET UP EXCEL
Dim FilePath As String
Dim FileName As String
Dim SheetName1 As String
Dim SheetName2 As String
Dim xlApp As Object
Dim xlWorkbook As Object
Dim xlSheet1 As Object
Dim xlSheet2 As Object
Set xlApp = CreateObject("Excel.Application")
'SETTING FILE PATH AND SHEET NAME
FilePath = "C:\users" & CDS_ID & "\Desktop\DATAMART\POTENTIAL HIGH AGEING PART STATUS" & Plant_Code.Value & " - Potential High Ageing - " & Format(Date, "dd") & "-" & Format(Date, "mmm") & "-" & Format(Date, "yy") & ".xls"
SheetName1 = "_" & Plant_Code.Value & "_PART STATUS"
SheetName2 = "_" & Plant_Code.Value & "_POTENTIAL HIGH AGEING"
FileName = Plant_Code.Value & " - Potential High Ageing - " & Format(Date, "dd") & "-" & Format(Date, "mmm") & "-" & Format(Date, "yy") & ".xls"
'CHECK IF FILE IS OPEN
Dim Ret
On Error Resume Next
Ret = IsWorkBookOpen(FilePath)
If Ret = True Then
MsgBox FileName & " is open. Please close it first.", vbExclamation, "File is OPEN"
Exit Sub
Else
End If
'DELETE EXISTING FILE
On Error Resume Next
If Dir(FilePath) <> "" Then
Kill (FilePath)
Else
End If
On Error GoTo 0
'RUN QUERY
Dim stDocName As String
stDocName = "High Ageing Part Status"
DoCmd.RunMacro stDocName
DoCmd.TransferSpreadsheet 1, 9, "tbl_Part_Status", FilePath, , SheetName1
DoCmd.TransferSpreadsheet 1, 9, "tbl_Part_Status", FilePath, , SheetName2
'EXCEL FILE
Set xlWorkbook = xlApp.Workbooks.Open(FilePath)
Set xlSheet1 = xlWorkbook.Worksheets(SheetName1) ==> Error starts here
Set xlSheet2 = xlWorkbook.Worksheets(SheetName2)
xlApp.Visible = True
xlApp.Windows(FileName).WindowState = -4137
xlApp.DisplayAlerts = False
xlSheet1.Select