ネットワークドライブ上にあるファイルを日付別にフォルダ作成し、振り分けしたいです。
以下、やりたいこと詳細です。
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
回答1件
あなたの回答
tips
プレビュー