問題の所在

以下の記事で作成したVBAが大活躍中なのだが、たまに、仕訳の年月日を、yyyy/mm/dd　が　dd/mm/yyyy　と勝手に変わってしまう不具合があり、それでもこれまでは弥生会計で読み込めたのだが、今回は数が多いためか読み込まないため、この点を改善するVBAを再度作成した。

この備忘メモ。

当事務所用）仕訳インポートの下処理で、フォルダ内のブックファイルのうちシート「取込」をcsv形式で保存し、上２行を削除するVBAのコードは？

結論

以下の通り：

\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

Sub ExportCleanAndDeleteTokumiCSV()
Dim folderPath As String
Dim fileName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim csvFileName As String
Dim cleanedCsvFileName As String
Dim tempWB As Workbook
Dim csvName As String
Dim c As Range

folderPath = ThisWorkbook.Path & “\”

‘ Step ①: 「*当月分.xlsx」ファイルを処理
fileName = Dir(folderPath & “*当月分.xlsx”)
Do While fileName <> “”
Set wb = Workbooks.Open(folderPath & fileName, ReadOnly:=True)

On Error Resume Next
Set ws = wb.Sheets(“取込”)
On Error GoTo 0

If Not ws Is Nothing Then
ws.Copy
Set tempWB = ActiveWorkbook

‘ ★★★ D列のみ日付を文字列化して変換されないようにする ★★★
With tempWB.Sheets(1)
For Each c In .Range(“D1”, .Cells(.Rows.Count, “D”).End(xlUp))
If IsDate(c.Value) Then
c.Value = Format(c.Value, “yyyy/mm/dd”)
End If
Next c
End With

csvFileName = folderPath & Replace(fileName, “.xlsx”, “”) & “_取込.csv”
tempWB.SaveAs Filename:=csvFileName, FileFormat:=xlCSV, Local:=True
tempWB.Close SaveChanges:=False
End If

wb.Close SaveChanges:=False
Set ws = Nothing
fileName = Dir()
Loop

‘ Step ②: 「*取込.csv」ファイルを加工して「_取込2.csv」に保存
csvName = Dir(folderPath & “*取込.csv”)
Do While csvName <> “”
Set tempWB = Workbooks.Open(folderPath & csvName)

With tempWB.Sheets(1)
.Rows(“1:2”).Delete
End With

cleanedCsvFileName = folderPath & Replace(csvName, “_取込.csv”, “_取込2.csv”)
tempWB.SaveAs Filename:=cleanedCsvFileName, FileFormat:=xlCSV, Local:=True
tempWB.Close SaveChanges:=False

csvName = Dir()
Loop

‘ Step ③: 元の「*取込.csv」ファイルを削除
csvName = Dir(folderPath & “*取込.csv”)
Do While csvName <> “”
Kill folderPath & csvName
csvName = Dir()
Loop

MsgBox “すべての処理（CSV保存・加工・削除）が完了しました！”
End Sub

\\\\\\\\\\\\\\\\\\\\\\\\\\\\

理由

COPILOTに指示したプロンプトは以下：

＝＝＝＝以下のVBAのプログラムを実行すると、yyyy/mm/dd　のデータが　dd/mm/yyyy　と変わってしまう不具合が生じることがあるので、それを生じないように修正してほしい

＝＝＝＝
Sub ExportCleanAndDeleteTokumiCSV()
Dim folderPath As String
Dim fileName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim csvFileName As String
Dim cleanedCsvFileName As String
Dim tempWB As Workbook
Dim csvName As String

‘ このVBAファイルと同じフォルダを対象
folderPath = ThisWorkbook.Path & “\”

‘ Step ①: 「*当月分.xlsx」ファイルを処理
fileName = Dir(folderPath & “*当月分.xlsx”)
Do While fileName <> “”
Set wb = Workbooks.Open(folderPath & fileName, ReadOnly:=True)

On Error Resume Next
Set ws = wb.Sheets(“取込”)
On Error GoTo 0

If Not ws Is Nothing Then
ws.Copy
Set tempWB = ActiveWorkbook

csvFileName = folderPath & Replace(fileName, “.xlsx”, “”) & “_取込.csv”
tempWB.SaveAs Filename:=csvFileName, FileFormat:=xlCSV
tempWB.Close SaveChanges:=False
End If

wb.Close SaveChanges:=False
Set ws = Nothing
fileName = Dir()
Loop

‘ Step ②: 「*取込.csv」ファイルを加工して「_取込2.csv」に保存
csvName = Dir(folderPath & “*取込.csv”)
Do While csvName <> “”
Set tempWB = Workbooks.Open(folderPath & csvName)

With tempWB.Sheets(1)
.Rows(“1:2”).Delete
End With

cleanedCsvFileName = folderPath & Replace(csvName, “_取込.csv”, “_取込2.csv”)
tempWB.SaveAs Filename:=cleanedCsvFileName, FileFormat:=xlCSV
tempWB.Close SaveChanges:=False

csvName = Dir()
Loop

‘ Step ③: 元の「*取込.csv」ファイルを削除
csvName = Dir(folderPath & “*取込.csv”)
Do While csvName <> “”
Kill folderPath & csvName
csvName = Dir()
Loop

MsgBox “すべての処理（CSV保存・加工・削除）が完了しました！”
End Sub

Sub ExportCleanAndDeleteTokumiCSV()
    Dim folderPath As String
    Dim fileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim csvFileName As String
    Dim cleanedCsvFileName As String
    Dim tempWB As Workbook
    Dim csvName As String
    Dim c As Range

    folderPath = ThisWorkbook.Path & "\"

    ' Step ①: 「*当月分.xlsx」ファイルを処理
    fileName = Dir(folderPath & "*当月分.xlsx")
    Do While fileName <> ""
        Set wb = Workbooks.Open(folderPath & fileName, ReadOnly:=True)

        On Error Resume Next
        Set ws = wb.Sheets("取込")
        On Error GoTo 0

        If Not ws Is Nothing Then
            ws.Copy
            Set tempWB = ActiveWorkbook

            ' ★★★ D列のみ日付を文字列化して変換されないようにする ★★★
            With tempWB.Sheets(1)
                For Each c In .Range("D1", .Cells(.Rows.Count, "D").End(xlUp))
                    If IsDate(c.Value) Then
                        c.Value = Format(c.Value, "yyyy/mm/dd")
                    End If
                Next c
            End With

            csvFileName = folderPath & Replace(fileName, ".xlsx", "") & "_取込.csv"
            tempWB.SaveAs Filename:=csvFileName, FileFormat:=xlCSV, Local:=True
            tempWB.Close SaveChanges:=False
        End If

        wb.Close SaveChanges:=False
        Set ws = Nothing
        fileName = Dir()
    Loop

    ' Step ②: 「*取込.csv」ファイルを加工して「_取込2.csv」に保存
    csvName = Dir(folderPath & "*取込.csv")
    Do While csvName <> ""
        Set tempWB = Workbooks.Open(folderPath & csvName)

        With tempWB.Sheets(1)
            .Rows("1:2").Delete
        End With

        cleanedCsvFileName = folderPath & Replace(csvName, "_取込.csv", "_取込2.csv")
        tempWB.SaveAs Filename:=cleanedCsvFileName, FileFormat:=xlCSV, Local:=True
        tempWB.Close SaveChanges:=False

        csvName = Dir()
    Loop

    ' Step ③: 元の「*取込.csv」ファイルを削除
    csvName = Dir(folderPath & "*取込.csv")
    Do While csvName <> ""
        Kill folderPath & csvName
        csvName = Dir()
    Loop

    MsgBox "すべての処理（CSV保存・加工・削除）が完了しました！"
End Sub

＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠

この修正で何が改善されるか

✔ D列だけを対象にするので高速

UsedRange 全体を走査しないため、処理が軽くなります。

✔ 日付が勝手に dd/mm/yyyy に変わらない

CSV 保存前に "yyyy/mm/dd" の文字列に変換するため、Excel がロケールに従って変換する余地がなくなります。

✔ Local:=True で日本語環境の CSV 保存を強制

より安定した出力になります。

＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠＠

補足

今回は一発で完成！　＼(^o^)／

■