ここから本文です

VBAコードの記述方法を教えてください。 下記のマクロで、フォルダの中のcsvを...

bbr********さん

2019/4/512:44:43

VBAコードの記述方法を教えてください。

下記のマクロで、フォルダの中のcsvを選択してcsv データを取り込むことで効率よくなりました。

このマクロを使い、フォルダの中にある複数のcsv

を1つずつと繰り返してやる作業になるのですが、、、

更にVBAコードを追加して、指定のフォルダの中のcsvブックが無くなる(別フォルダに移動されている)まで繰り返しす方法は、あるのでしょうか?

そうなると、1つずつ取り込む作業がなくなり、効率が上がるんじゃないかなと思ってました。


Sub test()

'------------------------------------------------------------------------------------------------------------
'ファイル選択
Dim FileName As String
ChDir "C:\Users"
FileName = Application.GetOpenFilename("CSVファイル,*.csv")
If FileName = "False" Then End
'------------------------------------------------------------------------------------------------------------
'ファイル取り込み
'すべての列を文字列で取り込むために長さ255の配列を用意する(Excelの最大列数が255)
Dim v(255) As Long, i As Long
For i = 0 To UBound(v)
v(i) = 2
Next

Dim ws As Worksheet
Dim qt As QueryTable
Worksheets.Add.Name = ("CSV取込")
Set ws = Worksheets("CSV取込")
Set qt = ws.QueryTables.Add("TEXT;" & FileName, ws.Range("A1"))
ws.Cells.Delete

With qt
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.TextFileColumnDataTypes = Array(v)
.TextFilePlatform = 932
.Refresh
.Delete
End With
'------------------------------------------------------------------------------------------------------------
'指定のセルにファイルのパスを記入
Application.ScreenUpdating = False
ws.Range("K1").Value = Left(FileName, InStrRev(FileName, "\")) & "CSV取込済" & "\" & Dir(FileName)
'CSV取込シート内容の一部を管理シートにコピペ
ws.Range("A1:K20").Copy
Sheets("管理").Range("F1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'------------------------------------------------------------------------------------------------------------
'CSVでシートを保存する
'済フォルダがなかったら作る
Dim Pas As String
Pas = Left(FileName, InStrRev(FileName, "\")) & "CSV取込済"
If Dir(Pas, vbDirectory) = "" Then MkDir Pas
Application.DisplayAlerts = False
ws.Copy
ActiveWorkbook.SaveAs Pas & "\" & Dir(FileName), xlCSV
ActiveWorkbook.Close
ActiveSheet.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'------------------------------------------------------------------------------------------------------------

MsgBox "CSV取込完了しました。", vbOKOnly
End Sub

閲覧数:
28
回答数:
1
お礼:
250枚

違反報告

ベストアンサーに選ばれた回答

tad********さん

2019/4/512:55:56

FileName = Dir("[フォルダパス] *.csv")
Do Until FileName = ""
(処理)
FileName = Dir()
Loop

これでフォルダ内のcsvファイルが全部取れます。

  • 質問者

    bbr********さん

    2019/4/600:11:42

    返事ありがとうございます。
    困ったことがありまして、、、
    先に、フォルダを指定しなければマクロが使用できないです。

    例えば、先にフォルダを開いてそのパスを格納して、DO〜LOOPが使用できたらと思ってました。

    この作業をするたびに取り込むフォルダの場所はバラバラなので、先にフォルダを指定しておかないとと作業が進まない状況です。

  • その他の返信(2件)を表示

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

質問した人からのコメント

2019/4/6 08:42:31

先に、フォルダからcsvファイル を選択してから実行した後に

if 〜then を使用し
フォルダ内にcsvファイル があれば、do 〜 loop を使用して解決できました。

ありがとうございます。

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる