文字操作 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, "Backup" Exit Sub error: MyErrorMsg End Sub |