Import files to the access database

[aman]

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.

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"

 

[arnelgp]

How di you save the username. Do you save it variable, which variable. Do you use environ("username"). This will return the computer name.

 

[isladogs]

Easy provided that users:
1. login to the db
2. first & last names are stored in the db either as 2 separate fields or as full name field

If so, add a function/variable to retrieve the user name
e.g. strUserName=DLookup("FullName","tblUsers","UserID='" & Me.UserID & "'")
Adapt this to suit your table & fields

If you don't have this, you#ll need to add an input box asking users to enter that info ... but that could get messy with typos etc

EDIT - just read arnel's reply. Definitely use environ rather than an input box.
In fact Environ("UserProfile") will give the default location for files ... and there are many other useful environ switches (38 in all)

 

[aman]

I am using using a function named nameofuser()

Function NameofUser() As String
'   Returns the name of the logged-in user
    Dim Buffer As String * 100
    Dim BuffLen As Long
    BuffLen = 100
    GetUserName Buffer, BuffLen
    NameofUser = Left(Buffer, BuffLen - 1)
End Function

SO what change needs to be made to create a new folder and add files or open the existing folder and add files in that?

 

[isladogs]

Just add that at the end of your constant value GetLinkedFilesPath

Something like:

Const GetLinkedFilesPath = "C:\Scanned Documents\" & NameOfUser()& "\"

or

Const GetLinkedFilesPath = "C:\Scanned Documents\" & '" & NameOfUser & "' & "\"

You may need to tweak it slightly to get the syntax correct
Add Debug.Print to test the output in immediate window

 

[arnelgp]

dont make GetLinkedFilePath variable a Constant:

Dim GetLinkedFilePath As String

GetLinkedFilePath = CreateImportFolder()



...

now add this to your Standard Module:

Public Function CreateImportFolder(Optional ByVal strFolder As String = "C:\Scanned Documents\")
    If Dir(strFolder, vbDirectory) = "" Then _
        MkDir strFolder
    strFolder = strFolder & NameOfuser() & "\"
    If Dir(strFolder, vbDirectory) = "" Then _
        MkDir strFolder
    CreateImportFolder = strFolder
End Function

[/codde]

 

[aman]

that's great Arnelgp, it works perfect