HillTJ
To train a dog, first know more than the dog..
- Local time
- Yesterday, 13:28
- Joined
- Apr 1, 2019
- Messages
- 731
Hi,after studying various routines I came up with a hybrid of my own. See attached. I decided that it was best to archive documents in a separate folder & not clutter Access. Now I'd like the routine to make a new folder every year to keep size down. This is my code so far. I'd appreciate it if anyone can review it & give me some direction. I've commented out the if statement that I was attempting to figure out for the time being. As always. Cheers
Code:
Private Sub Browse_To_File_Click()
On Error GoTo Err_Handler
Dim strFullpath As String
Dim strFolder As String
Dim strFile As String
Dim intPos As Integer
Dim InPath As String
Dim FileName As String
Dim OutFolder As String
Dim OutPath As String
Dim RecordNo As String
Dim FileExt As String
Dim Archieve As String
'Dim fsFolder As Object
strFullpath = BrowseFile
RecordNo = Me!BatchUniqueID
Archieve = Archieve_Path ' gets the default path from Module "Constants" Currently C:\users\tandi\Archieve
'Set fsFolder = CreateObject("Scripting.FileSystemObject") ' This routine is to create a new folder each year-- Does not work--
'strFullpath = Archieve & Year(Date)
'Debug.Print strFullpath
'If fsFolder.FolderExists(strFullpath) = False Then
'fsFolder.CreateFolder (strFullpath)
'End If
If strFullpath <> "" Then ' get folder and file names
intPos = InStrRev(strFullpath, "")
strFolder = Left(strFullpath, intPos - 1)
strFile = Mid(strFullpath, intPos + 1)
InPath = strFullpath
End If
If Len(InPath) > 0 Then
FileName = Mid(InPath, InStrRev(InPath, "") + 1) 'get the file name
FileExt = Right(FileName, Len(FileName) - InStrRev(FileName, ".") + 1) ' get the file extension with dot
OutPath = [Archieve] & "" & FileName & RecordNo & " Attachment " & Format(Now(), "ddmmmyy") & FileExt
If (IsNull(Me.[Out_Path]) Or Me.[Out_Path] = "") Then Me.[Out_Path] = OutPath 'Allows the file save position to be relocated"
FileCopy InPath, Out_Path
Me!Out_Path = "#" & [Out_Path] & "#"
MsgBox "Copied file to archives " & vbCrLf & InPath & vbCrLf & OutPath
End If
Exit_Here:
Exit Sub
Err_Handler:
MsgBox Err.Description
Resume Exit_Here
End Sub
Last edited by a moderator: