我需要能够运行导出，并且我的三个日期字段需要以MM/DD/YYYY文本格式输出。它们都将以相同的日期填充。我该怎么做呢?
下面的三个日期列，后面是Access中的VBA文本用于导出。请帮助!最终用户需要能够将其导入到另一个工具中而不进行更改，日期格式不被接受。
'Public Const ActivityStartDateCol As String = "E"
'Public Const ActivityEndDateCol As String = "F"
'Public Const PaymentDateCol As String = "K"
Option Compare Database
Public Const UploadTemplateFilePath As String = "\mmpfs04.endo.sanSharedASSCCegedimUpload TemplatePCard_DB_Upload_Template_Final.xlsx"
Public Const ActivityCountryCol As String = "A"
Public Const ActivityOwnerCol As String = "B"
Public Const ActivityNameCol As String = "C"
Public Const ActivityTypeCol As String = "D"
Public Const ActivityStartDateCol As String = "E"
Public Const ActivityEndDateCol As String = "F"
Public Const Prod1Col As String = "G"
Public Const ExpenseTypeCol As String = "H"
Public Const CurrencyCol As String = "I"
Public Const Amt1Col As String = "J"
Public Const PaymentDateCol As String = "K"
Public Const CustomerIDCol As String = "L"
Public Const AdditionalInformationCol As String = "M" 'MedEd Event Code
Public Const VendorCol As String = "N"
Public Const ActivityStateCol As String = "O"
Public Const ActivityCityCol As String = "P"
Public Const ExternalActivityIDCol As String = "Q"
Public Const ExternalExpenseIDCol As String = "R"
Public Const Prod2Col As String = "S"
Public Const Prod3Col As String = "T"
Public Const Prod4Col As String = "U"
Public Const Prod5Col As String = "V"
Public Const HCPEventCodeCol As String = "W"
Public Const HCPNameFromSpreadsheetCol As String = "X" 'HCP Traveler Name
Public Const OriginalTotalAmountCol As String = "Y" 'Total Expense Amount
Public Const EmployeeFirstNameCol As String = "Z" 'Booker Name
Public Const ManualSpendFormNameCol As String = "AA" 'Source File Name
Public Const UploadTemplateNameCol As String = "AB" 'Upload File Name
Public Sub MakeUploadSpreadsheet()
On Error GoTo ErrorHandler
DoCmd.Hourglass True
Dim objXLApp As Object
Dim objXLWb As Object
Dim objXLSheet As Object
Dim rs As DAO.Recordset
Dim fld As DAO.Field
Dim strWorkBook As String
Dim strWorkSheet As String
Dim ToRow As Integer
Dim strTableName As String
Dim strFileName As String
Dim strFilePath As String
Dim UserName As String
Dim StartTime As Double
Dim TimeElapsed As Double
Dim Step1 As Double
Dim Step2 As Double
Dim Step3 As Double
CurrentDb.Execute ("q_Product 1 Text Mapping")
CurrentDb.Execute ("q_Product 2 Text Mapping")
CurrentDb.Execute ("q_Product 3 Text Mapping")
CurrentDb.Execute ("q_Product 4 Text Mapping")
CurrentDb.Execute ("q_Product 5 Text Mapping")
'Updates the Activity and Expense Type
CurrentDb.Execute ("q_Nature Text Mapping")
CurrentDb.Execute ("q_Move Processed Records")
'Set variables for upload template file name, sheet name, starting field and temp table
strWorkBook = UploadTemplateFilePath
strWorkSheet = "Worksheet"
ToRow = 6
strTableName = "tblProcessed Records"
'Set recordset as temp table
Set rs = CurrentDb.OpenRecordset(strTableName)
'Create references to Excel upload template file
Set objXLApp = CreateObject("Excel.Application")
Set objXLWb = objXLApp.Workbooks.Open(strWorkBook)
Set objXLSheet = objXLWb.Worksheets(strWorkSheet)
strDate = Date
strTime = Time
strDate = Format(CStr(strDate), "YYYYMMDD")
strTime = Format(CStr(strTime), "HHMMSS")
strFilePath = "\mmpfs04.endo.sanSharedASSCProductionUpload_SpreadsheetsAirfare" & "_" & UserName & "_" & strDate & "_" & strTime & ".xlsx" 'Destination of file
With rs
Do Until .EOF
If rs![Reportable Status] = "Reportable" Then
objXLSheet.Range(ActivityCountryCol & ToRow).Value = rs![Destination Country Code]
objXLSheet.Range(ActivityOwnerCol & ToRow).Value = "United States"
objXLSheet.Range(ActivityNameCol & ToRow).Value = "Airfare_" & rs![ID] & "_" & rs![Ticket Number]
objXLSheet.Range(ActivityTypeCol & ToRow).Value = rs![Activity Type]
objXLSheet.Range(ActivityStartDateCol & ToRow).Value = rs![Ticket Departure Date]
objXLSheet.Range(ActivityEndDateCol & ToRow).Value = rs![Ticket Departure Date]
objXLSheet.Range(ExpenseTypeCol & ToRow).Value = rs![Expense Type]
objXLSheet.Range(CurrencyCol & ToRow).Value = "USD"
objXLSheet.Range(Amt1Col & ToRow).Value = rs![Reported Amount]
objXLSheet.Range(PaymentDateCol & ToRow).Value = rs![Ticket Departure Date]
objXLSheet.Range(CustomerIDCol & ToRow).Value = rs![Client Defined 11]
objXLSheet.Range(Prod1Col & ToRow).Value = rs![Product 1 Text]
objXLSheet.Range(ExternalActivityIDCol & ToRow).Value = "Airfare_" & rs![ID] & "_" & rs![Ticket Number]
objXLSheet.Range(ExternalExpenseIDCol & ToRow).Value = "Airfare_" & rs![ID] & "_" & rs![Ticket Number]
objXLSheet.Range(VendorCol & ToRow).Value = "Airfare"
objXLSheet.Range(HCPEventCodeCol & ToRow).Value = rs![Client Defined 14]
'Test if product 2-5 exist and only copy into upload template if they do
If rs![Product 2 Text] <> "" Then
objXLSheet.Range(Prod2Col & ToRow).Value = rs![Product 2 Text]
End If
If rs![Product 3 Text] <> "" Then
objXLSheet.Range(Prod3Col & ToRow).Value = rs![Product 3 Text]
End If
If rs![Product 4 Text] <> "" Then
objXLSheet.Range(Prod4Col & ToRow).Value = rs![Product 4 Text]
End If
If rs![Product 5 Text] <> "" Then
objXLSheet.Range(Prod5Col & ToRow).Value = rs![Product 5 Text]
End If
objXLSheet.Range(ActivityCityCol & ToRow).Value = rs![Destination City Name]
If rs![Destination Country Code] = "US" Then
objXLSheet.Range(ActivityStateCol & ToRow).Value = rs![Destination State-Province Code]
End If
objXLSheet.Range(HCPNameFromSpreadsheetCol & ToRow).Value = rs![Traveler Name]
objXLSheet.Range(OriginalTotalAmountCol & ToRow).Value = rs![Paid Fare]
objXLSheet.Range(EmployeeFirstNameCol & ToRow).Value = rs![Client Defined 08]
objXLSheet.Range(ManualSpendFormNameCol & ToRow).Value = rs![file name]
objXLSheet.Range(UploadTemplateNameCol & ToRow).Value = strFilePath
'Adds file name from of this upload spreadsheet within the Archive table
rs.Edit
rs![Exported File Name].Value = strFilePath
rs.Update
ToRow = ToRow + 1
End If
.MoveNext
Loop
End With
objXLSheet.Columns.autofit
'Save wb using 'Save As' so Template is not overwritten
objXLWb.SaveAs strFilePath
objXLWb.Close
MsgBox "The data has been Transferred - You can find the file here: \mmpfs04.endo.sanSharedASSCProductionUpload_Spreadsheets"
CurrentDb.Execute ("q_Delete Processed HCP Flights")
CurrentDb.Execute ("q_Archive Exported Flights")
CurrentDb.Execute ("q_Delete Processed Temp Table")
ErrorHandler_Exit:
DoCmd.Hourglass False
'close up other rs objects
If Not rs Is Nothing Then rs.Close
Set rs = Nothing
Set objXLSheet = Nothing
Set objXLWb = Nothing
'quit Excel
If Not objXLApp Is Nothing Then objXLApp.Quit
Set objXLApp = Nothing
Exit Sub
ErrorHandler:
' Display error information.
MsgBox "Error number " & Err.Number & ": " & Err.Description
' Resume with statement following occurrence of error.
Resume ErrorHandler_Exit
End Sub
试试吧?
objXLSheet.Range(ActivityStartDateCol & ToRow).Value = format(rs![Ticket Departure Date],"mm/dd/yyyy")
objXLSheet.Range(ActivityEndDateCol & ToRow).Value = format(rs![Ticket Departure Date],"mm/dd/yyyy")