ループとコピーファイルを組み合わせてアクセスする2016 vba

Question

Private Sub Command203_Click() 'DOWNLOAD ALL ANNEXURES AT ONCE 
Dim rs As DAO.Recordset 
Set rs = CurrentDb.OpenRecordset("SELECT IDRT FROM RT WHERE STRT=ME.IDMN") 
'Check to see if the recordset actually contains rows 
If Not (rs.EOF And rs.BOF) Then 
    rs.MoveFirst 'Unnecessary in this case, but still a good habit 
    Do Until rs.EOF = True 
    Picker = "D:\1\" 'Destination path 
    path = [Forms]![1userselect]![APPENDIX] 'Get source file path 
    strFileName = Dir(path & IDRT & ".*") 
    Ext = Right(strFileName, Len(strFileName) - InStrRev(strFileName, ".")) 
    Dot = "." 
    S = path & IDRT & Dot & Ext 
    D = Picker & IDRT & Dot & Ext 
    FileCopy S, D 
     'Move to the next record. Don't ever forget to do this. 
     rs.MoveNext 
    Loop 
Else 
    MsgBox "There are no annexures in this report." 
End If 
MsgBox "Finished downloadinng annexures." 
rs.Close 'Close the recordset 
Set rs = Nothing 'Clean up 
End Sub 

私は監査人であり、VBAの知識は非常に限られています。上記のコードは、さまざまな人のコピー貼りです。私が学ぶのに役立つように、何を変えなければならないかについてのコメントが追加されていれば役に立ちます。 タスク：レコードセットをループし、自分のフォーム（Me.IDMN）にSTRTを持つレコードのIDRT（サーバーフォルダ内のファイル名）を取得します。 問題：クエリービルダーでSQL select文をテストすると、フィルタリングされたIDRTが正しく取得されます。 copyfileの仕組みも別々にテストされ、うまくいきます（私がIDRTを自分でテキストボックスに入れた場合）。

Answer 1

SQLを正しく作成しているように見えません。

試してみてください。

Set rs = CurrentDb.OpenRecordset("SELECT IDRT FROM RT WHERE STRT=" & Me.IDMN) 

IDMNが数値である場合。

それとも

Set rs = CurrentDb.OpenRecordset("SELECT IDRT FROM RT WHERE STRT='" & Me.IDMN & "'") 

テキスト

Answer 2

次のコードは、現在動作しているか：

Private Sub Command6_Click() 

Dim rs As DAO.Recordset 
Dim sourcePATH As String 
Dim destinPATH As String 
Dim StrSQL As String 
Dim strFileName As String 
Dim exten As String 
Dim source As String 
Dim destin As String 

sourcePATH = "D:\1\" 
destinPATH = "D:\2\" 
StrSQL = "SELECT RT.STRT, RT.IDRT " & _ 
      "FROM RT " & _ 
      "WHERE (((RT.STRT) = " & Me.Text2 & "))" 

Set rs = CurrentDb.OpenRecordset(StrSQL) 
rs.MoveFirst 
Do Until rs.EOF 
strFileName = Dir(sourcePATH & rs!IDRT & ".*") 
If Len(strFileName) = 0 Then 
rs.MoveNext 
Else 
exten = Right(strFileName, Len(strFileName) - InStrRev(strFileName, ".")) 
source = sourcePATH & rs!IDRT & "." & exten 
destin = destinPATH & rs!IDRT & "." & exten 
FileCopy source, destin 
rs.MoveNext 
End If 
Loop 
rs.Close 
Set rs = Nothing 
Set db = Nothing 
End Sub