访问格式Excel行作为短日期(始终还原为美国)

时间:2016-06-02 15:10:10

标签: excel-vba datetime formatting access-vba vba

我有一个烦人的问题,即我有csv文件以我需要更改的日期格式保存,例如dd-mmm-yyyy到dd / mm / yyyy。

如果我直接在子文件中输入文件名和路径,但是当我将其称为子例程并将名称作为变量字符串传递时,我的子文件将起作用,它总是以美国格式保存日期,例如mm / dd / yyyy(例如2016年6月1日发生交叉的情况发生在06/01/2016)。

这样可行:

Sub TEST_openfile()
Dim fmDate As Date

Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")

'Workbook to open
xlApp.workbooks.Open "S:\Data\20160601.csv", , False

'Make sure excel is visible on the screen
xlApp.Visible = True
xlApp.Windows(1).Visible = True

'Define the sheet in the Workbook as XlSheet
Set xlsheet1 = xlApp.Worksheets(1)

'Format date column to short date format
With xlsheet1
    .Columns("A:A").NumberFormat = "dd/mm/yyyy"
End With

Set xlsheet1 = Nothing

'Close workbook save changes (disables alerts as csv always generate save prompt even if you have saved the file).
xlApp.Application.displayalerts = False
xlApp.activeworkbook.Save
xlApp.Quit
xlApp.Application.displayalerts = True
Set xlApp = Nothing

End Sub

但是如果我尝试在这样的子程序中使用它:

Sub Import_multiple_csv_files()
'This is for the funnel detailed report.
'Requires an extra sub routine to open the csv files and format the dates correctly before importing

DoCmd.SetWarnings False

    Const strPath As String = "C:\Data\" 'Directory Path
    Const strPathNew As String = "C:\Data\Loaded\" 'Move files too
    Dim strFile As String 'Filename
    Dim strFileList() As String 'File  Array
    Dim intFile As Integer 'File Number

    'Loop through the folder & build file list
    strFile = Dir(strPath & "*.csv")
    While strFile <> ""
        'add files to the list
        intFile = intFile + 1
        ReDim Preserve strFileList(1 To intFile)
        strFileList(intFile) = strFile
        strFile = Dir()
    Wend
     'see if any files were found
    If intFile = 0 Then
        MsgBox "No Data Files Were Found", vbInformation + vbOKOnly, "No Files"
        Exit Sub
    End If
     'cycle through the list of files &  import to Access
    For intFile = 1 To UBound(strFileList)
        'Define variable to pass to sub routine
        strFile = strPath & strFileList(intFile)
        'Call sub routine to open csv file first and format dates
        Call openfile(strFile)
        'Import to db
        DoCmd.TransferText acImportDelimi, "Funnel Import Specification", _
        "Import Data", strPath & strFileList(intFile), True
        'MoveFile
        Name strPath & strFileList(intFile) As strPathNew & strFileList(intFile)
    Next

    Call DeleteImportErrorTables
    DoCmd.SetWarnings False
    DoCmd.OpenQuery "qry_Delete_Total", acViewNormal, acEdit
    DoCmd.SetWarnings True
    MsgBox UBound(strFileList) & " file(s) imported", vbOKOnly + vbInformation, "Data Imported"

DoCmd.SetWarnings True

End Sub

使用子例程:

Sub openfile(strFile As String)
Dim fmDate As Date

Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")

'Workbook to open
xlApp.workbooks.Open strFile, , False

'Make sure excel is visible on the screen
xlApp.Visible = True
xlApp.Windows(1).Visible = True

'Define the sheet in the Workbook as XlSheet
Set xlsheet1 = xlApp.Worksheets(1)

'Format date column to short date format
With xlsheet1
    .Columns("A:A").NumberFormat = "m/d/yyyy"
End With

Set xlsheet1 = Nothing

'Close workbook save changes (disables alerts as csv always generate save prompt even if you have saved the file).
xlApp.Application.displayalerts = False
xlApp.activeworkbook.Save
xlApp.Quit
xlApp.Application.displayalerts = True
Set xlApp = Nothing

End Sub

因此,当单独运行并声明其中的文件和路径时,第一个子工作正常。

但是第二个代码和被调用的子程序总是使日期恢复为美国格式并且它让我疯狂。

我确实尝试了格式“m / d / yyyy”,这是在更改列格式时记录在excel宏中的。我认为区域设置是为了将日期恢复到本地设置。这不起作用:(

任何建议都会非常感谢你。

0 个答案:

没有答案