Hi Guys
I have been using following code to add files to the database. I am looking for some code to add in this existing code so that it creates a unique folder for each user and then store a copy of the files in that folder. At the moment all the files get stored in "C:\Scanned Documents"
But I want this to be stored in "C:\Scanned Documents\Dan Jukes" if my username is Dan Jukes. SO basically create a new folder for each user in ""C:\Scanned Documents" and if the user folder exists then just add files in already existing folder.
Rest of the code will remain same except the statement with red font.
I have been using following code to add files to the database. I am looking for some code to add in this existing code so that it creates a unique folder for each user and then store a copy of the files in that folder. At the moment all the files get stored in "C:\Scanned Documents"
But I want this to be stored in "C:\Scanned Documents\Dan Jukes" if my username is Dan Jukes. SO basically create a new folder for each user in ""C:\Scanned Documents" and if the user folder exists then just add files in already existing folder.
Rest of the code will remain same except the statement with red font.
Code:
Private Sub bImport1_Click()
Dim strMsgReturn As String, strFilePath As String, strFileName As String, strFolderPath As String
Dim strNewFilePath As String, strFileType As String
[COLOR=red]Const GetLinkedFilesPath = "C:\Scanned Documents\"[/COLOR]
Dim strsql As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
strFolderPath = Trim(Me.txtFile)
Do Until Right((strFolderPath), 1) = "\"
strFolderPath = Left(strFolderPath, Len(strFolderPath) - 1)
Loop
'Determine file name
strFileName = Mid(Me.txtFile, Len(strFolderPath) + 1)
'Determine file type e.g. ".doc" so it can be added to new filename if needed
strFileType = Trim(strFileName)
If InStr(strFileType, ".") = 0 Then 'file has no file type suffix . . .reject it!
MsgBox "This file cannot be used as the file type is unknown ", vbCritical, "Unknown file type"
Exit Sub
Else 'file type suffix OK. . . .
Do Until Left((strFileType), 1) = "."
strFileType = Mid(strFileType, 2)
Loop
End If
strNewFilePath = GetLinkedFilesPath & strFileName
' MsgBox strNewFilePath
If Len(strNewFilePath) > 255 Then
strMsgReturn = MsgBox("The file name is too long (>255 characters) " & vbNewLine & _
"Do you want to save it with a new name?", vbCritical + vbYesNo, "Copy selected file?")
If strMsgReturn = vbYes Then
strFileName = InputBox("Enter a new name for this file", "New file name")
strNewFilePath = GetLinkedFilesPath & strFileName & strFileType
FileCopy strFilePath, strNewFilePath
Else
MsgBox "The file was not linked as its file name was too long (>255 characters) "
End If
End If
'Check whether file already exists
If (Dir(strNewFilePath) = "") Then 'file missing . . . so copy it
FileCopy Me.txtFile, strNewFilePath
Else
Rename:
strMsgReturn = MsgBox("Another file with this name already exists on the network. " & vbNewLine & _
"Do you want to save it with a new name?", vbCritical + vbYesNo, "Copy selected file?")
If strMsgReturn = vbYes Then
strFileName = InputBox("Enter a new name for this file", "New file name")
strNewFilePath = GetLinkedFilesPath & strFileName & strFileType
If (Dir(strNewFilePath) <> "") Then GoTo Rename 'this file also exists, so try again
FileCopy Me.txtFile, strNewFilePath 'copy the file
Else ' Use existing linked file - CR v4683
Exit Sub
End If
End If
Me.LinkedFile = strNewFilePath
'MsgBox strFileName
Set db = CurrentDb()
strsql = "SELECT * FROM tImport WHERE 1=0"
Set rs = db.OpenRecordset(strsql, dbOpenDynaset, dbSeeChanges)
rs.AddNew
rs!FilePath = Me.LinkedFile
rs!FileName = strFileName
rs!ActivityRef = Me.txtRefNo
rs!FormRef = 24
rs.Update
MsgBox "The new file has been attached", vbInformation + vbOKOnly, "Added"
Me.txtFile = ""
DoCmd.Close acForm, Me.Name
End Sub"