I have an Export procedure that renames the query (which
is the worksheet name) each time I use it (sometimes I
loop through names and call the export procedure each
time NewName is set). The variables strTitle and Newname
are public string variables set in the click event of the
command button. stFileName is also a public variable but
doesn't have to be.
This procedure prompts the user for an existing file name
with a dialog box but you could use it without it and
hardcode the stFileName
strTitle is the titlebar text in the dialog box in
GetOpenFileName.
OldName is the name of the query
NewName is the name I want the worksheet to be
Browsefile is a function in a module that uses the
GetOpenFileName function in comdlg32.dll (I'll post that
after the Export function).
If you want the field names in the first row, change the
false to true in the TransferSpreadsheet action.
This is in the click event of the command button:
NewName = [Forms]![ExportToExcel]!Discipline 'Worksheet
name
OldName = "ExportDiscipline" 'Query name
Call Export
End Sub
Put this in a module:
Public Sub Export()
strTitle = "Select Existing File in which to
Export or Type Name of NEW file"
stFileName = BrowseFile("C:\", "xls")
Dim msg As String
If stFileName <> "" Then
msg = MsgBox("This action will overwrite any
existing worksheet called '" & NewName & "' in the
file: " & stFileName & "." & (Chr(13)) & (Chr(13))
& "Shall I continue?", 36, "CAUTION!")
If msg = vbYes Then
DoCmd.Rename NewName, acQuery, OldName
DoCmd.TransferSpreadsheet acExport,
acSpreadsheetTypeExcel97, NewName, stFileName, False
DoCmd.Rename OldName, acQuery, NewName
MsgBox ("The data has been exported to an
Excel worksheet called '" & NewName & "' in the file: " &
stFileName)
End If
End If
End Sub
Put this in a module by itself:
Public stFileName As String
Public NewName As String
Public OldName As String
Public strTitle As String
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
'For Browsefile function
Private Declare Function GetOpenFileName
Lib "comdlg32.dll" Alias "GetOpenFileNameA"
(pOpenfilename As OPENFILENAME) As Long
Public Function BrowseFile(strPath As String, Optional
strFileType As String) As String
Dim OpenFile As OPENFILENAME
Dim lngreturn As Long
Dim strFilter As String
Dim strThisFile As String
Dim iLocation As Integer
'Check path
If IsNull(strPath) Or strPath = vbNullString Then
strPath = "c:\"
End If
'Check file type (extension)
Select Case UCase(strFileType)
Case "XLS"
strFilter = "Excel Files (*.xls)" & Chr(0)
& "*.xls" & Chr(0)
Case "MDB"
strFilter = "Access Databases (*.mdb)" & Chr
(0) & "*.mdb" & Chr(0)
Case "TXT"
strFilter = "Text Files (*.txt)" & Chr(0)
& "*.txt" & Chr(0)
Case "DOC"
strFilter = "Word Files (*.doc)" & Chr(0)
& "*.doc" & Chr(0)
Case Else
strFilter = "All Files (*.*)" & Chr(0)
& "*.*" & Chr(0)
End Select
'Execute
OpenFile.lStructSize = Len(OpenFile)
'strFilter = "Excel Files (*.xls)" & Chr(0) & "*.xls"
& Chr(0)
OpenFile.lpstrFilter = strFilter
OpenFile.nFilterIndex = 1
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = strPath
OpenFile.lpstrTitle = strTitle
OpenFile.flags = 0
lngreturn = GetOpenFileName(OpenFile)
If lngreturn = 0 Then
strThisFile = ""
Else
strThisFile = OpenFile.lpstrFile
iLocation = InStr(strThisFile, Chr(0))
strThisFile = Left(strThisFile, iLocation - 1)
End If
BrowseFile = strThisFile
End Function
I didn't write the BrowseFile function but I use it a LOT!
If this doesn't work, email me!
Laurel
(e-mail address removed)
