ACCESSテーブルデータから複数のファイル名変更保存

ACCESS2013、テーブル1にコピー元ファイルパス、NEWファイル名が入っています(約50レコード）

やりたいこと；
コピー元ファイルパスからコピー先パスへファイル名をNEWファイル名に変えて保存したい。
（下記コードにNEWファイル名をどこに書いたらいいか分かりません）

Private Sub コマンド0_Click()

Dim oFSO As Object
Dim rs As New ADODB.Recordset
Const sToPath As String = "コピー先パス"
Set oFSO = CreateObject("Scripting.FileSystemObject")

rs.Open "テーブル1", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
While (Not rs.EOF)
If (Len(Nz(rs("コピー元パス"))) > 0) Then
oFSO.CopyFile rs("コピー元パス"), sToPath
End If
rs.MoveNext
Wend
rs.Close

End Sub

参考URL；https://oshiete.goo.ne.jp/qa/4831478.html

haruru413

No.2 ベストアンサー 回答者： ShowMeHow 回答日時： 2020/11/20 14:14

Const sToPath As String = "rs!NEWファイル名"

とすると、
sToPath には「rs!NEWファイル名」という文字列が格納されます。

ループの中に・・・というのはこういうことです。
While (Not rs.EOF)
If (Len(Nz(rs("コピー元パス"))) > 0) Then
sToPath=rs!NEWファイル名
oFSO.CopyFile rs("コピー元パス"), sToPath
End If
rs.MoveNext
Wend

とすると、データベースの該当レコードの　NEWファイル名　というフィールドの値が　sToPath　に格納されます。



このあたりはちゃんと区別できていますか？

この回答へのお礼

ShowMeHow 様

再度ご回答いただきありがとうございます。

>Const sToPath As String = "rs!NEWファイル名"
おかしいことにすぐ気付かないのが初心者ですね。

>ループの中に・
LOOPを使うということではないのですね。

下記で目的が達成されたので活用させていただきます。
（教えていただいたとおりですが。。）
ありがとうございました。

　Private Sub コマンド0_Click()

Dim oFSO As Object
Dim rs As New ADODB.Recordset
Dim sToPath As String

'Const sToPath As String = "C:\Users\xxxx\Desktop"

Set oFSO = CreateObject("Scripting.FileSystemObject")

rs.Open "テーブル1", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
While (Not rs.EOF)
If (Len(Nz(rs("コピー元パス"))) > 0) Then
sToPath = rs!NEWファイル名
oFSO.CopyFile rs("コピー元パス"), sToPath
End If
rs.MoveNext
Wend
rs.Close

　End Sub

お礼日時：2020/11/20 15:35

No.1 回答者： ShowMeHow 回答日時： 2020/11/20 11:44

もともと(コピー元)のファイル名がわかりませんが、、、

loopの中で、
sToPath ＝ "コピー先パス" & "\" & rs!NEWファイル名
などとするとよいと思います。

この回答へのお礼

ShowMeHow 様

ご回答いただきありがとうございます。
参考URL、https://oshiete.goo.ne.jp/qa/4831478.htmlに習い
コピー元ファイルにはフルパスが入っていたので、
教えて頂いた通りNEWファイル名にコピー先パスを追加してデータを変更しました。

　 Private Sub コマンド0_Click()

Dim oFSO As Object
Dim rs As New ADODB.Recordset
　
'Const sToPath As String = "\\C:\XXXX\Desktop\""" & """rs!NEWファイル名"

Const sToPath As String = "rs!NEWファイル名"

Set oFSO = CreateObject("Scripting.FileSystemObject")

rs.Open "テーブル1", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
Do While (Not rs.EOF)
If (Len(Nz(rs("コピー元パス"))) > 0) Then
oFSO.CopyFile rs("コピー元パス"), sToPath
End If
rs.MoveNext
Loop

'Wend
rs.Close

End Sub

エラーも出ませんがファイルも保存されないので、もう一度始めからやり直してみます。
ファイル名が変更され保存されるようになりましたら改めて連絡させていただきます。
ありがとうございました。

お礼日時：2020/11/20 14:06