M
misschanda via AccessMonster.com
Hi all,
I cannot get my access search form to export to excel The following is the
export code. The file only saves as a shortcut that can't be found. Anyhelp
is appreciated.
Thanks
misschanda
Private Function ExportRoutine()
Dim db As Database
Dim qdf As QueryDef
Dim lorst As Recordset
Dim strName As String
Dim strFile As String
Const strSpecName = "~~TempSpec~~"
On Error GoTo ExportRoutine_err
With Me.lstResult
strFile = DialogFile(OFN_SAVE, "Save file", "", .Column(3) & " (" & .
Column(2) & ")|" & .Column(2), CurDir, .Column(2))
End With
If Len(strFile) > 0 Then
'first get a unique name for the querydef object
strName = Application.Run("wzmain80.wlib_stUniquedocname", "Query1",
acQuery)
Set db = CurrentDb
Set qdf = db.CreateQueryDef(strName, Me.txtSQL)
qdf.CLOSE
With lstResult
Select Case .Column(0)
Case 0 'Transferspreadsheet
DoCmd.TransferSpreadsheet acExport, .Column(1), strName, strFile,
True
Case 1 'Transfertext
If .Column(1) = acExportFixed Then
'Considerations
'Do MsysImexColumns and MsysImexSpecs exist
'Need to create if not
'Can use Max Length on each field in query to get lengths for MsysImexSpecs
' Set lorst = db.OpenRecordset(strName)
'Do loads of other stuff in here ...
' DoCmd.TransferText .Column(1), , strName, strFile, True
Else
DoCmd.TransferText .Column(1), , strName, strFile, True
End If
End Select
End With
End If
ExportRoutine_end:
On Error Resume Next
DoCmd.DeleteObject acQuery, strName
qdf.CLOSE
Set qdf = Nothing
db.QueryDefs.Refresh
Set db = Nothing
Exit Function
ExportRoutine_err:
Resume ExportRoutine_end
End Function
I cannot get my access search form to export to excel The following is the
export code. The file only saves as a shortcut that can't be found. Anyhelp
is appreciated.
Thanks
misschanda
Private Function ExportRoutine()
Dim db As Database
Dim qdf As QueryDef
Dim lorst As Recordset
Dim strName As String
Dim strFile As String
Const strSpecName = "~~TempSpec~~"
On Error GoTo ExportRoutine_err
With Me.lstResult
strFile = DialogFile(OFN_SAVE, "Save file", "", .Column(3) & " (" & .
Column(2) & ")|" & .Column(2), CurDir, .Column(2))
End With
If Len(strFile) > 0 Then
'first get a unique name for the querydef object
strName = Application.Run("wzmain80.wlib_stUniquedocname", "Query1",
acQuery)
Set db = CurrentDb
Set qdf = db.CreateQueryDef(strName, Me.txtSQL)
qdf.CLOSE
With lstResult
Select Case .Column(0)
Case 0 'Transferspreadsheet
DoCmd.TransferSpreadsheet acExport, .Column(1), strName, strFile,
True
Case 1 'Transfertext
If .Column(1) = acExportFixed Then
'Considerations
'Do MsysImexColumns and MsysImexSpecs exist
'Need to create if not
'Can use Max Length on each field in query to get lengths for MsysImexSpecs
' Set lorst = db.OpenRecordset(strName)
'Do loads of other stuff in here ...
' DoCmd.TransferText .Column(1), , strName, strFile, True
Else
DoCmd.TransferText .Column(1), , strName, strFile, True
End If
End Select
End With
End If
ExportRoutine_end:
On Error Resume Next
DoCmd.DeleteObject acQuery, strName
qdf.CLOSE
Set qdf = Nothing
db.QueryDefs.Refresh
Set db = Nothing
Exit Function
ExportRoutine_err:
Resume ExportRoutine_end
End Function