文字操作 CSV形式テキストファイル出力

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。


Sub AddCSV()
'*******************************
'CSV形式テキストファイル出力
'*******************************
'フィールド名に「日」の文字を含む場合"yyyy/mm/dd"形式にする。
On Error GoTo error:

Dim sht(1 To 2) As Worksheet
Dim bok As Workbook
Dim MyPath As String
Dim MyPath2 As String
Dim i As Byte
Dim j As Long
Const shtFol As String = "\Backup"
Dim Fso As Object
Dim Chack As Boolean

Set bok = Workbooks("pdpData.xls")
Set sht(1) = bok.Worksheets("会計伝票")
Set sht(2) = bok.Worksheets("カルテ")

Application.ScreenUpdating = False
   
Set Fso = CreateObject("Scripting.FileSystemObject")
    
MyPath2 = bok.Path & shtFol
    
Chack = Fso.Folderexists(MyPath2)
    
If Chack = False Then   '無ければ作成
    Fso.createfolder (MyPath2)
End If
   
Set Fso = Nothing
   
MyPath = bok.Path & shtFol & "\"


For i = 1 To 2
    With sht(i)
    If Dir(MyPath & .Name & ".csv") <> "" Then Kill MyPath & .Name & ".csv"
        Application.DisplayAlerts = False
            For j = 1 To .Range("A1").SpecialCells(xlCellTypeLastCell).Column
                If InStr(1, .Cells(1, j).Value, "日") <> 0 Then
                    .Columns(j).NumberFormat = "yyyy/mm/dd"
                End If
            Next j
        .Copy
        ActiveWorkbook.SaveAs Filename:=MyPath & .Name & ".csv", _
            FileFormat:=xlCSV, CreateBackup:=False
        ActiveWorkbook.Close SaveChanges:=False
        Application.DisplayAlerts = True
    End With
    Set sht(i) = Nothing
Next i

Set bok = Nothing

MsgBox MyPath & "バックアップをしました", 0, "Ｂａｃｋｕｐ"

Exit Sub
error:
MyErrorMsg
End Sub

 

 

 

2000年01月01日|[VBサンプルコード]:[文字操作]