Moving Documents

[Rich1968]

Ok June I have been coming back to this when I have time and still can't seem to get it right. time is short, closing March 31st. So please one more time

File structure:

Documents are located in C:\CMSDocs

I want to move them to C:\ClientDocs

Table holding the document list is tblDocuments
Two fields
ClientID
DebtorID


Sub PDF()
Dim rsClients As DAO.Recordset
Dim rsDocs As DAO.Recordset
Set rsClients = CurrentDb.OpenRecordset("SELECT DISTINCT ClientID FROM tblDocuments;")
While Not rsClients.EOF



Set rsDocs = CurrentDb.OpenRecordset("SELECT ClientID, DebtorID FROM tblDocuments WHERE ClientID = " & rsClients!ClientID;") "Getting a syntax error here"

While Not rsDocs.EOF

MkDir "C:\ClientDocs\" & ClientID

FileCopy "C:\ClientDocs\" & rsDocs!DebtorID, "C:\ClientDocs\" & ClientID = "\" & rsDocs!DebtorID

rsDocs.MoveNext
Wend
rsDocs.Close
rsClients.MoveNext
Wend

End Sub

[June7]

The syntax error is because of missing & " at end of the SQL statement. Should be: = " & rsClients!ClientID & ";")

Does DebtorID have the name of the file, including the file extension?

Alternative code structure as suggested in post 9 with a little change to make sure only records with data in ClientID and DebtorID are retrieved and fixed some typos in the original example:

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT ClientID, DebtorID FROM tblDocuments WHERE NOT ClientID IS NULL and NOT DebtorID IS Null ORDER BY ClientID, DebtorID;")
While Not rs.EOF
If Dir("C:\ClientDocs\" & rs!ClientID, vbDirectory) = "" Then MkDir("C:\ClientDocs\" & rs!ClientID)
FileCopy "C:\ClientDocs\" & rs!DebtorID, "C:\ClientDocs\" & rs!ClientID & "\" & rs!DebtorID
rs.MoveNext
Wend

[Rich1968]

June,

The name of the field that holds the document is tblDocuments!DebtorID

The PDF Files are located in C:\CMSDocs

Here's my code. It come up with an error "File Not Found"

Sub PDF()
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT ClientID, DebtorID FROM tblDocuments WHERE NOT ClientID IS NULL and NOT DebtorID IS Null ORDER BY ClientID, DebtorID;")

While Not rs.EOF

If Dir("C:\ClientDocs\" & rs!ClientID, vbDirectory) = "" Then MkDir ("C:\ClientDocs\" & rs!ClientID)

FileCopy "C:\CMSDocs\" & rs!DebtorID, "C:\ClientDocs\" & rs!ClientID & "\" & rs!DebtorID "Error File Not Found"

rs.MoveNext

Wend

End Sub

[June7]

Then use CMSDocs instead of ClientDocs.

Might also want to make sure the PDF file exists before trying to copy.

If Dir("C:\CMSDocs\" & rs!ClientID & "\" & rs!DebtorID) <> "" Then
FileCopy ...
End If

[Rich1968]

June,

Thanks for all the help. The code created the directory's however it did not copy the PDF files to them. Should I use a .pdf extention. ?

Thanks

Rich

[June7]

I have asked if the file name in DebtorID includes the extension. Yes, need the extension. If it is not in the data then concatenate it in the code.

[Rich1968]

June,

.PDF is not in the data, However it is a PDF file.

I get the folders made but no PDF files copied to them.

Thanks
Rich

[June7]

Don't know what else to say. The code works for me. But since I am not on your system I can't test. If there were Windows permission issues then a failure message should generate.

Post the revised code that concatenates the extension.

[Rich1968]

Don't know what else to say. The code works for me. But since I am not on your system I can't test. If there were Windows permission issues then a failure message should generate.

Post the revised code that concatenates the extension.

Here's the revised code


Sub PDF()
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT ClientID, DebtorID FROM tblDocuments WHERE NOT ClientID IS NULL and NOT DebtorID IS Null ORDER BY ClientID, DebtorID;")

While Not rs.EOF

If Dir("C:\ClientDocs\" & rs!ClientID, vbDirectory) = "" Then MkDir ("C:\ClientDocs\" & rs!ClientID)

If Dir("C:\CMSDocs\" & rs!ClientID & "\" & rs!DebtorID) <> "" Then "I thought this code would determine if the pdf was in CMSDocs"

FileCopy "C:\CMSDocs\" & rs!DebtorID, "C:\ClientDocs\" & rs!ClientID & "\" & rs!DebtorID Error File not found. The pdf file #010195 is not in CMSDocs

End If
rs.MoveNext

Wend

End Sub

[June7]

You are not concatenating the extension.

& rs!DebtorID & ".pdf"

[Rich1968]

Hey June,

Even with the .pdf extention no joy. I am going to go to plan B. since time is short. I really appreciate your help. I know I have not been the best student......If I can help you in any way please call me

God Bless
Rich De Gray
229-869-5831

[June7]

Sorry, it doesn't work. I know it is a proven technique because I use it.

[Rich1968]

I limited the PDF file to one record. I know the file exists. The code references the file in the filecopy expression. Oh well.

[Rich1968]

June,
Will a friend of mine who I did not know was an expert with VBA. Sent mw the code to copy all the PDF files. I thought you would like a copy of it. I really appreciate your help. God Bless You.

Rich
Sub MovePDF()

Dim rs As DAO.Recordset
Dim i As Integer
Dim x As Integer
Dim Failed As String

On Error GoTo Err_Proc
Set rs = CurrentDb.OpenRecordset("SELECT ClientID, DebtorID FROM tblDocuments;")
i = 1
x = 0

While Not rs.EOF
If Dir("C:\ClientDocs\", vbDirectory) = "" Then MkDir "C:\ClientDocs\"
If Dir("C:\ClientDocs\" & rs!ClientID, vbDirectory) = "" Then MkDir ("C:\ClientDocs\" & rs!ClientID)
If Dir("C:\CMSDocs\" & rs!DebtorID & ".pdf", vbNormal) = "" Then
Failed = i & ". " & rs!DebtorID & vbCrLf
i = i + 1
Else
FileCopy "C:\CMSDocs\" & rs!DebtorID & ".pdf", "C:\ClientDocs\" & rs!ClientID & "\" & rs!DebtorID & ".pdf"
x = x + 1
End If
rs.MoveNext

Wend
MsgBox "Copied a total of " & x & " PDF files.", vbInformation, "Files Transfered"
If Failed <> "" Then MsgBox "The following records did not have a corresponding PDF file to move:" & vbCrLf & vbCrLf & Failed, vbExclamation, "Failed"

End
Exit_Proc:
On Error Resume Next
rs.Close
Set rs = Nothing
Exit Sub
Err_Proc:
MsgBox Err.Source & " " & Err.Number & " " & Err.Description
Resume Exit_Proc
End Sub