質問編集履歴

2 追記

4n5

4n5 score 16

2018/09/16 09:05  投稿

VBAにて複数ファイルを振り分け
ネットワークドライブ上にあるファイルを日付別にフォルダ作成し、振り分けしたいです。
以下、やりたいこと詳細です。
1.エクセルシートに移動前・移動後ディレクトリ、作成するフォルダ名のマスタがあるのでそれから情報を取得
2.各移動先ディレクトリに新規フォルダの作成
3.2で作成したフォルダにxlsxファイルとcsvファイルを移動
(マスタシートB列に移動前Dir,C列に移動後Dir,D列に作成するファルダ名としています)
```
こんな感じのイメージです。
Aフォルダ
 ┣oldフォルダ
 ┣ファイルA.xlsx
 ┣ファイルB.xlsx
 ┣ファイルC.xlsx
 ┗ファイルD.csv
 ↓
Aフォルダ
 ┣oldフォルダ
   ┗新規フォルダ
    ┣ファイルA.xlsx
    ┣ファイルB.xlsx
    ┣ファイルC.xlsx
    ┗ファイルD.csv
```
以下、コードですがこれを実行すると「FSO.MOVEFILE consSOUR, consDEST」の部分でファイルが見つかりませんとエラーになってしまいます。
・FileSystemObjectの参照設定は行っております。
・csvとxlsxを両方指定する方法が分からなかったので一旦xlsxの移動のコードのみです。
```
Sub test()
'FSO
Dim FSO As FileSystemObject
Set FSO = New FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
'************************************フォルダ作成****************************************
'Dir情報取得
Dim sour, dest, consSOUR, consDEST As Long
Dim FolderName, Path, TargetPath As String
'作成するフォルダ名を指定
FolderName = Cells(7, 4).Value
'移動先パス指定
Dim i As Long
For i = 7 To Range("C7").End(xlDown).Row
Path = Cells(i, 3).Value
TargetPath = Path & "\" & FolderName
If (FSO.FolderExists(TargetPath) = False) Then
'//フォルダが存在しない
FSO.createFolder (TargetPath)
Else
'//フォルダが存在する
GoTo continue
End If
continue:
Next
'************************************ファイル移動****************************************
Dim j
For j = 7 To Cells(Rows.Count, "B").End(xlUp).Row
sour = Cells(j, 2).Value
dest = Cells(j, 3).Value
consSOUR = sour & "\" & "*.xlsx"
consDEST = dest & "\" & FolderName
'FSOによるファイルコピー
FSO.MOVEFILE consSOUR, consDEST
Next j
'オブジェクトの解放
Set FSO = Nothing
MsgBox "移動完了しました"
End Sub
```
また、色々調べてみてshellobjを追加してみましたが同じ結果になったので一旦上記のコードからは省いてます。
この際「Windows Script Host Object Model」の参照設定も行いました。
```
'追加したshellobj
Dim ShellObj
   Set ShellObj = CreateObject("WScript.Shell")
   ShellObj.Run "net use consSOUR, 0, True"
```
分かる方、ご教示いただければと思います。
宜しくお願い致します。
宜しくお願い致します。
【追記】
「Debug.Print ; consSOUR」と「Debug.Print ; consDEST」を「FSO.MOVEFILE consSOUR, consDEST」の直前に追加し、内容が以下になります。
\\space\kyouyu\各案件フォルダ\【201809分】\①インポート\*.xlsx
\\space\kyouyu\各案件フォルダ\【201809分】\①インポート\old\0913
また、「fso.FileExists」を以下のような形で追加し確認したところ「consSOUR が存在しません」と表示されました。
```
If FSO.FileExists(consSOUR) Then
    MsgBox consSOUR & "が存在します"
     If FSO.FileExists(consDEST) Then
        MsgBox consDEST & "が存在します"
 Else
        MsgBox consDEST & "が存在しません"
 End If
 Else
    MsgBox consSOUR & "が存在しません"
 End If
```
  • VBA

    3665 questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    2998 questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

1 書式改善

4n5

4n5 score 16

2018/09/16 08:12  投稿

VBAにて複数ファイルを振り分け
ネットワークドライブ上にあるファイルを日付別にフォルダ作成し、振り分けしたいです。
以下、やりたいこと詳細です。
1.エクセルシートに移動前・移動後ディレクトリ、作成するフォルダ名のマスタがあるのでそれから情報を取得
2.各移動先ディレクトリに新規フォルダの作成
3.2で作成したフォルダにxlsxファイルとcsvファイルを移動
(マスタシートB列に移動前Dir,C列に移動後Dir,D列に作成するファルダ名としています)
```
こんな感じのイメージです。
Aフォルダ
 ┣oldフォルダ
 ┣ファイルA.xlsx
 ┣ファイルB.xlsx
 ┣ファイルC.xlsx
 ┗ファイルD.csv
 ↓
Aフォルダ
 ┣oldフォルダ
 ┗新規フォルダ
  ┣ファイルA.xlsx
  ┣ファイルB.xlsx
  ┣ファイルC.xlsx
  ┗ファイルD.csv
   ┗新規フォルダ
    ┣ファイルA.xlsx
    ┣ファイルB.xlsx
    ┣ファイルC.xlsx
    ┗ファイルD.csv
```
以下、コードですがこれを実行すると「FSO.MOVEFILE consSOUR, consDEST」の部分でファイルが見つかりませんとエラーになってしまいます。
・FileSystemObjectの参照設定は行っております。
・csvとxlsxを両方指定する方法が分からなかったので一旦xlsxの移動のコードのみです。
```
Sub test()
'FSO
Dim FSO As FileSystemObject
Set FSO = New FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
'************************************フォルダ作成****************************************
'Dir情報取得
Dim sour, dest, consSOUR, consDEST As Long
Dim FolderName, Path, TargetPath As String
'作成するフォルダ名を指定
FolderName = Cells(7, 4).Value
'移動先パス指定
Dim i As Long
For i = 7 To Range("C7").End(xlDown).Row
Path = Cells(i, 3).Value
TargetPath = Path & "\" & FolderName
If (FSO.FolderExists(TargetPath) = False) Then
'//フォルダが存在しない
FSO.createFolder (TargetPath)
Else
'//フォルダが存在する
GoTo continue
End If
continue:
Next
'************************************ファイル移動****************************************
Dim j
For j = 7 To Cells(Rows.Count, "B").End(xlUp).Row
sour = Cells(j, 2).Value
dest = Cells(j, 3).Value
consSOUR = sour & "\" & "*.xlsx"
consDEST = dest & "\" & FolderName
'FSOによるファイルコピー
FSO.MOVEFILE consSOUR, consDEST
Next j
'オブジェクトの解放
Set FSO = Nothing
MsgBox "移動完了しました"
End Sub
```
また、色々調べてみてshellobjを追加してみましたが同じ結果になったので一旦上記のコードからは省いてます。
この際「Windows Script Host Object Model」の参照設定も行いました。
```
'追加したshellobj
Dim ShellObj
   Set ShellObj = CreateObject("WScript.Shell")
   ShellObj.Run "net use consSOUR, 0, True"
```
分かる方、ご教示いただければと思います。
宜しくお願い致します。
  • VBA

    3665 questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    2998 questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

思考するエンジニアのためのQ&Aサイト「teratail」について詳しく知る