G
Guest
Ultimately what I would like to happen is the below code uses an excel
template, or formats a new spreadsheet, and that the columns from my table go
to specific columns in excel. I know I can’t do that with the
transferspreadsheet method but I am unable to figure out another way.
Option Compare Database
Private Sub Command0_Click()
If Len(Dir("C:\TransferStation\ExportExcel", vbDirectory)) = 0 Then
MkDir "C:\TransferStation\ExportExcel"
End If
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim strSQL As String
Dim strPath As String
Dim ExcelApp As Object
Dim wrkbuk As Object
Dim xl As Excel.Application
Dim xlbook As Excel.workbook
Dim xlsheet As Excel.worksheet
Set dbs = CurrentDb
On Error Resume Next
dbs.QueryDefs.Delete ("qryloc")
On Error GoTo 0
Set qdf = dbs.CreateQueryDef("qryloc")
Set rst = dbs.OpenRecordset("SELECT DISTINCT [loc] " & _
"FROM [TblMaintbl]")
With rst
Do While Not .EOF
strSQL = "SELECT loc, item FROM [TblMaintbl] WHERE [loc] = """ & _
![Loc] & """"
qdf.SQL = strSQL
strPath = "C:\TransferStation\ExportExcel\ " & _
![Loc] & ".xls"
On Error Resume Next
Kill strPath
On Error GoTo 0
DoCmd.TransferSpreadsheet _
TransferType:=acExport, _
TableName:="qryloc", _
FileName:=strPath
.MoveNext
Loop
.Close
End With
Set rst = Nothing
Set dbs = Nothing
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "All files have been exported to C:\TransferStation\ExportExcel. Do
you want to open folder ?" ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "Question" ' Define title.
Ctxt = 1000 ' Define topic
' context.
' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' User chose Yes.
Dim MyPath As String
MyPath = "C:\TransferStation\ExportExcel"
Application.FollowHyperlink MyPath
Else ' User chose No.
MyString = "No" ' Perform some action.
End If
End Sub
template, or formats a new spreadsheet, and that the columns from my table go
to specific columns in excel. I know I can’t do that with the
transferspreadsheet method but I am unable to figure out another way.
Option Compare Database
Private Sub Command0_Click()
If Len(Dir("C:\TransferStation\ExportExcel", vbDirectory)) = 0 Then
MkDir "C:\TransferStation\ExportExcel"
End If
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim strSQL As String
Dim strPath As String
Dim ExcelApp As Object
Dim wrkbuk As Object
Dim xl As Excel.Application
Dim xlbook As Excel.workbook
Dim xlsheet As Excel.worksheet
Set dbs = CurrentDb
On Error Resume Next
dbs.QueryDefs.Delete ("qryloc")
On Error GoTo 0
Set qdf = dbs.CreateQueryDef("qryloc")
Set rst = dbs.OpenRecordset("SELECT DISTINCT [loc] " & _
"FROM [TblMaintbl]")
With rst
Do While Not .EOF
strSQL = "SELECT loc, item FROM [TblMaintbl] WHERE [loc] = """ & _
![Loc] & """"
qdf.SQL = strSQL
strPath = "C:\TransferStation\ExportExcel\ " & _
![Loc] & ".xls"
On Error Resume Next
Kill strPath
On Error GoTo 0
DoCmd.TransferSpreadsheet _
TransferType:=acExport, _
TableName:="qryloc", _
FileName:=strPath
.MoveNext
Loop
.Close
End With
Set rst = Nothing
Set dbs = Nothing
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "All files have been exported to C:\TransferStation\ExportExcel. Do
you want to open folder ?" ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "Question" ' Define title.
Ctxt = 1000 ' Define topic
' context.
' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' User chose Yes.
Dim MyPath As String
MyPath = "C:\TransferStation\ExportExcel"
Application.FollowHyperlink MyPath
Else ' User chose No.
MyString = "No" ' Perform some action.
End If
End Sub