accessVBAで特定の文字列を削除
以前頼んで作ってもらったVBAを少し改造しようと思っていますが、上手くいきませんので質問します。よろしくお願いします。
csvファイルを分割するVBAを作ってもらいました。
1001,a12345678
1001,b15467863546789
1001,b25463254875698
1001,c23564879
1005,a23456753
1005,b25647565823653
1005,c26546875
1007,a23456789
1007,b23659856325632
1007,b46785215468523
1007,c12546873
というcsvファイルを
1001.csvというファイルで中身は
1001,a12345678
1001,b15467863546789
1001,b25463254875698
1001,c23564879
と
1005.csvというファイルで中身は、
1005,a23456753
1005,b25647565823653
1005,c26546875
と
1007.csvというファイルで中身は、
1007,a23456789
1007,b23659856325632
1007,b46785215468523
1007,c12546873
の3つのcsvファイルに分けます。
今回は仕様変更で、
1001.csvというファイルで中身は
a12345678
b15467863546789
b25463254875698
c23564879
と
1005.csvというファイルで中身は、
a23456753
b25647565823653
c26546875
と
1007.csvというファイルで中身は、
a23456789
b23659856325632
b46785215468523
c12546873
の3つに分けなくてはならなくなりました。
今使っているVBAは
Private Sub DOQUERY_Click()
Dim IN_FNO As Integer
Dim OUT_FNO As Integer
Dim BREAK_OLD As String
Dim BREAK_NEW As String
Dim HEADLINE As String
Dim TEXTLINE As String
Dim ARY() As String
Dim OUTNAME As String
Dim ARYNAME() As String
Dim CNT As Integer
Dim MSG As String
'============================================
On Error GoTo err
If IsNull(InputFile) Or IsNull(OutputFile) Then
Exit Sub
End If
If InputFile = "" Or OutputFile = "" Then
MsgBox "ファイル名が正しく指定されていません。", vbCritical
Exit Sub
End If
ラベル5.Visible = True
DoEvents
'読込みCSV OPEN
IN_FNO = FreeFile
Open InputFile For Input As #IN_FNO
'見出し読込み
Line Input #IN_FNO, HEADLINE$
'1レコード目読込み
Line Input #IN_FNO, TEXTLINE$
'発注番号
ARY() = Split(TEXTLINE$, ",")
BREAK_NEW = Replace(ARY(0), """", "")
BREAK_OLD = BREAK_NEW
'出力CSVファイル名作成
OUTNAME = OutputFile & BREAK_NEW & ".csv"
'出力CSVファイル名保存
CNT = 1
ReDim Preserve ARYNAME(CNT)
ARYNAME(CNT) = OUTNAME
'出力CSV OPEN
OUT_FNO = FreeFile
Open OUTNAME For Output As #OUT_FNO
'見出し書込み
Print #IN_FNO, HEADLINE$
'1レコード目書込み
Print #IN_FNO, TEXTLINE$
Do While Not EOF(IN_FNO)
'次レコード目読込み
Line Input #IN_FNO, TEXTLINE$
'発注番号
ARY() = Split(TEXTLINE$, ",")
BREAK_NEW = Replace(ARY(0), """", "")
'発注番号が変わったとき新しいCSVを開く
If BREAK_OLD <> BREAK_NEW Then
CNT = CNT + 1
BREAK_OLD = BREAK_NEW
'旧書込みCSVをクローズ
Close #OUT_FNO
'新出力CSVファイル名作成
OUTNAME = OutputFile & BREAK_NEW & ".csv"
'新出力CSVファイル名保存
ReDim Preserve ARYNAME(CNT)
ARYNAME(CNT) = OUTNAME
'新出力CSV OPEN
OUT_FNO = FreeFile
Open OUTNAME For Output As #OUT_FNO
End If
'次レコード書込み
Print #OUT_FNO, TEXTLINE$
Loop
'出力CSVクローズ
Close #OUT_FNO
'入力CSVクローズ
Close #IN_FNO
'出力したCSV名称一覧
Dim I As Integer
For I = 1 To UBound(ARYNAME())
MSG = MSG & ARYNAME(I) & vbCrLf
Next
MsgBox CNT & "個のファイルに分割しました。" & vbCrLf + vbCrLf & MSG, vbInformation, "CSV分割"
ラベル5.Visible = False
Exit Sub
err:
MsgBox err.Description, vbCritical, "エラー"
ラベル5.Visible = False
End Sub
です。
ファイル名がBREAK_NEWでそれを消せればいいと思うのですが・・・
以上長くなりましたが、よろしくお願いします。
お礼
bluecampusさん、ありがとうございました。 おっしゃる通り、権限が決められているため保存できないようでした。 大変申し訳ありませんでした。 また何かありましたら、よろしくお願いいたします。