将本机excel日期导出为文本字符串

时间:2014-06-12 19:37:34

标签: excel vba date csv

今天我遇到了尝试逐行编写csv文件的问题,其中一列格式化为本机excel日期。我的脚本有效,但没有正确导出日期,并且正在导出为串行字符串。我只是希望导出的文件在" mm / dd / yyyy"中写入日期。格式。有什么想法吗?

Sub OUTPUT_COMMA_DELIMITED_RANGE()

Dim outputPath As String
Dim outputFileName As String
Dim rSrc As Range
Dim rSrcRow As Range
Dim fso As FileSystemObject
Dim fOut As TextStream

On Error GoTo SomethingBadHappened
Dim MyPathFull As String



outputPath = "C:\workspace\Appendix_Working_Area\Script_Out\"

    outputFileName = "Z225R" & Chr(95) & "Eddy_Fluctuating_Zone.csv"
MyPathFull = outputPath & outputFileName


    Set fso = CreateObject("scripting.filesystemobject")
    Set fOut = fso.CreateTextFile(outputPath & outputFileName)

    Dim EddyHghEleZoneRng As Range

    Set EddyHghEleZoneRng = Worksheets("225R").Range(Cells(1, 9), Cells(1, 9).End(xlToRight).End(xlDown))
    Set rSrc = EddyHghEleZoneRng

    For Each rSrcRow In rSrc.Rows
        fOut.WriteLine Join(Application.WorksheetFunction.Transpose _
                           (Application.WorksheetFunction.Transpose(rSrcRow)), ",")
    Next rSrcRow

    MsgBox "File " & outputPath & outputFileName & " created successfully"

SomethingBadHappened:
If Err.Number <> 0 Then MsgBox Err.Description
On Error Resume Next
fOut.Close
If Err.Number <> 0 And Err.Number <> 91 Then MsgBox "Unable to close file (" & Err.Description & ")"
End Sub

我选择手动创建csv文件,因为ID不希望任何与使用内置的FileFormat:=xlCSV功能相关联的不需要的字符表现出色。

为了提供我正在处理的数据类型的示例,我创建了一个我想要输出csv文件的示例。

网站,日期,Plane_Height,Area_2D,Area_3D,体积,错误 225R,11/3 / 1990,8kto25k,2212.834,2235.460,841.76655,88.513

谢谢,

dubbbdan

1 个答案:

答案 0 :(得分:2)

您的数据似乎包含在6列中。这是一种制作 .csv 的方法,可以保留日期格式:

Sub MakeCSVFile()
    Dim N As Long, M As Long, i As Long, j As Long
    Dim OutRec As String
    N = Cells(Rows.Count, "A").End(xlUp).Row
    M = 6
    Close #1
    Open "C:\TestFolder\x.csv" For Output As #1
    For i = 1 To N
        OutRec = Cells(i, 1).Text
        For j = 2 To M
            OutRec = OutRec & "," & Cells(i, j).Text
        Next j
        Print #1, OutRec
    Next i
    Close #1
End Sub