Public Sub Copy2All()
' ShowMsg "Copying..."
vSrc = CurrentDb.Name ' getCfgProdDb()
'get extension name
vExt = Mid(CurrentDb.Name, InStrRev(CurrentDb.Name, "."))
'get all the users folders from the table in the form
With Me.Recordset
.MoveFirst
While Not .EOF
'pack up both name and path
vDir = .Fields("folder").Value
vNam = .Fields("UserName").Value
vWord = vNam & kCHR & vDir
colDirs.Add vWord
.MoveNext
Wend
End With
'go thru the collection and copy to the user
For Each vWord In colDirs
'break up name@dir
i = InStr(vWord, kCHR)
If i = 0 Then
vNam = txtName
vDir = txtDir
Else
vNam = Left(vWord, i - 1)
vDir = Mid(vWord, i + 1)
End If
getDirName vSrc, X, f
vTarg = FixDir(vDir) & f
'ShowMsg "Copying to " & vbCrLf & vNam 'put this message on the form
Copy1File vSrc, vTarg
skipIt:
Next
MsgBox "Done", , "Distribution"
Set colDirs = Nothing
End Sub
'given filepath, passes back: Dir name , filename
Public Sub getDirName(ByVal psFilePath, ByRef prvDir, Optional ByRef prvFile)
'psFilePath: full file path given
'prvDir : directory name output
'prvFile: filename only output
Dim i As Integer, sDir As String
i = InStrRev(psFilePath, "\")
If i > 0 Then
prvDir = Left(psFilePath, i)
prvFile = Mid(psFilePath, i + 1)
If Asc(Mid(prvFile, Len(prvFile), 1)) = 0 Then RemoveLastChr prvFile
End If
End Sub
Public Sub Copy1File(ByVal pvSrc, ByVal pvTarg)
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile pvSrc, pvTarg
Set FSO = Nothing
End Sub