CSVファイルへの保存(Print #)
シートをCSVファイルへ保存する例を示す。ファイル名の取得、上書きの確認、ファイルが開けることの確認、書き込みを行っている。Print #で、1行ずつ(Ln)、ファイルに書き込んでいる。1つの文字列と認識できるよう、文字列を判別して""で囲んでいる。Sub CsvWrite() Dim FilDlg As FileDialog Dim SfsObj As Object Dim PasNom As String Dim SavNom As Variant Dim Ln As Variant Dim ir As Long Dim MaxRow As Long Dim Mc As Long Dim ic As Long Dim MaxClm As Integer Dim jCncel As Integer Dim jer As Integer Dim i As Long Dim j As Integer MaxRow = ActiveSheet.UsedRange.Rows.Count MaxClm = ActiveSheet.UsedRange.Columns.Count'保存するファイル名を取得する PasNom = ThisWorkbook.Path If Right(PasNom, 1) <> "\" Then PasNom = PasNom & "\" SavNom = PasNom & "test.csv" 'デフォルトファイル名 SavNom = Application.GetSaveAsFilename( _ Title:="保存先の指定", _ InitialFileName:=SavNom, _ FileFilter:="csv形式,*.csv") If SavNom = False Then MsgBox "cancelが押されました" Exit Sub ElseIf Dir(SavNom) <> "" Then If MsgBox("同名のファイルが存在します。上書きしますか?", vbYesNo) = _ vbNo Then Exit Sub End If On Error Resume Next '開けることの確認 Err.Clear Open SavNom For Append As #1 Close #1 If Err.Number > 0 Then MsgBox "ファイルが開けません" jer = 1 Else jer = 0 End If On Error GoTo 0 If jer = 1 Then Exit Sub Open SavNom For Output As #1 For i = 1 To MaxRow Mc = 0 For j = MaxClm To 1 Step -1 If Cells(i, j) <> "" Then Mc = j Exit For End If Next j Select Case Mc Case Is < 1 Print #1, vbCrLf Case 1 If VarType(Cells(i, 1).Value) = vbString Then Print #1, """" & Replace(Cells(i, 1), vbLf, vbNewLine) & """" Else Print #1, Replace(Cells(i, 1), vbLf, vbNewLine) End If Case Else Ln = "" For j = 1 To Mc - 1 If VarType(Cells(i, j).Value) = vbString Then Ln = Ln & """" & Replace(Cells(i, j), vbLf, vbNewLine) & """," Else Ln = Ln & Replace(Cells(i, j), vbLf, vbNewLine) & "," End If Next j If VarType(Cells(i, Mc).Value) = vbString Then Ln = Ln & """" & Replace(Cells(i, Mc), vbLf, vbNewLine) & """" Else Ln = Ln & Replace(Cells(i, Mc), vbLf, vbNewLine) End If Print #1, Ln End Select Next i Close #1End Sub