Sorry this has taken so long to get back to you but you did a really great job on the code its more then I expected. I have been taking it apart and trying different things to learn from it and I have learned allot from it already.
Thanks.
I'm having one issue. I cant get the code to send the file I pick to a folder on the server. I can get it to send to most anyplace on my desktop or local system, but when it gets to a server location I must have some syntax issue. How do I get the file to go to
\\SVR0621P01\data\DE MOD Share\DATA FOLDER\WNTY DATABASE MASTER\Shared Documents\VendorDocs
I'm pretty sure it goes in the code between the lines i have marked with ***************
I my mind the line that currently reads:
strDestination = CurrentProject.Path & "\Shared_Folders" 'set the path to the destination folder
should read
strDestination = CurrentProject.Path & "\\SVR0621P01\data\DE MOD Share\DATA FOLDER\WNTY DATABASE MASTER\Shared Documents\VendorDocs"
Can you explain what I'm Doing wrong?
Thanks
Code:
Private Sub CopyToShared(strSource As String)
Dim strDestination As String, FilExt As String
Dim NewName As String, NewPath As String
' Set fso = New FileSystemObject
' If Not fso.FolderExists(CurrentProject.Path & "\Shared_Folders") Then 'make sure folder exists
' fso.CreateFolder CurrentProject.Path & "\Shared_Folders"
' End If
'*************************************************************************************
strDestination = CurrentProject.Path & "\Shared_Folders" 'set the path to the destination folder
FilExt = fso.GetExtensionName(strSource) ' get file extension from source file
' **************************************************************************************
TryAgain:
NewName = InputBox("Please enter a New File Name" & vbNewLine & "Do not include the file extension, (ie.'.Doc')")
If NewName = "" Then Exit Sub
NewPath = fso.BuildPath(strDestination, NewName & "." & FilExt)
If fso.FileExists(NewPath) Then MsgBox "Name already exists. Try Again": GoTo TryAgain 'if file already exists re-try name
fso.CopyFile strSource, NewPath, False 'copy the file to the destination folder
InsertInTable Me.VendorLink, NewName & "." & FilExt, NewPath 'insert the file info into table
End Sub
Private Sub InsertInTable(VID As Long, FilName As String, FPath As String)
Const QDef_Insert As String = _
"Insert into tblDocuments" & _
"(VendorLink,DocumentName,Location) " & _
"Values(p0,p1,p2)"
With CurrentDb.CreateQueryDef("", QDef_Insert)
.Parameters(0) = VID
.Parameters(1) = FilName
.Parameters(2) = FPath
.Execute dbFailOnError
.Close
End With
End Sub