Code: Select all
Sub GoogleImages()
Const strSource = "L:\mmpdf\ConsoleFiles\"
Const strTarget = "C:\Users\dave.willett\Google Drive\ImagePath\"
Dim fso As Object
Dim fld As Object
Dim fil As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim i As Long
On Error Resume Next
If Len(Dir("C:\Users\dave.willett\Google Drive\ImagePath", vbDirectory)) > 0 Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("qryAllInProgressGallery", dbOpenDynaset)
Do While Not rst.EOF
If fso.FolderExists(strSource & rst!JobID) Then
Set fld = fso.GetFolder(strSource & rst!JobID)
i = 0
For Each fil In fld.Files
If LCase(Right(fil.Name, 4)) = ".jpg" Then
fil.Copy strTarget
i = i + 1
If i = 10 Then Exit For
End If
Next fil
End If
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
Set dbs = Nothing
Set fso = Nothing
End If
End Sub