CCSlice
New Member
- Joined
- Feb 11, 2022
- Messages
- 20
- Office Version
- 2016
- Platform
- Windows
Hi,
I am hopeful and thankful for any help on this. I have been looking at my code and I cannot figure out why the files in column G are not being copied to their new locations. I have checked the strings for both source and destination locations, as well as the database names.
Here is the
I am hopeful and thankful for any help on this. I have been looking at my code and I cannot figure out why the files in column G are not being copied to their new locations. I have checked the strings for both source and destination locations, as well as the database names.
Here is the
VBA Code:
Sub dbReplicate()
Dim FileName, fDtName, dbTarget, newFile As String
Dim i As Long
dbRosterFolder = ActiveWorkbook.Sheets("Production Dbs") _
.Range("D1").CurrentRegion.Columns(4).Value
fDtName = Format(Now, "yyyy-mm-dd ")
' Loop through Db Roster locations
For i = 2 To UBound(dbRosterFolder)
dbTargetFile = Sheets("Production Dbs").Range("F" & i).Resize(1, 3)
Dim dbDirectoryContents() As String
ReDim dbDirectoryContents(1000)
dbTarget = Dir$(Cells(i, 4).Value)
Dim FilesofInterest As Variant
FilesofInterest = Array(dbTargetFile)
On Error Resume Next
Do While dbTarget <> ""
dbDirectoryContents(Counter) = dbTarget
dbTarget = Dir$
' Conditional Statement to determine if file
' is found and to be copied
If InStr(dbTarget, FilesofInterest) > 0 Then
newFile = fDtName & dbTarget
FileCopy Cells(i, 4).Value & dbTarget, _
Cells(i, 5).Value & newFile
End If
Loop
Counter = Counter + 1
' When all dbFiles copied, update the "Back Up Date"
' field with date and timestamp
With Cells(i, 9)
.Value = Format(Now, "mm-dd-yyyy hh:nn")
.Font.Bold = True
End With
Next i
MsgBox "Database Backup Operation complete", vbInformation
End Sub
Last edited by a moderator: