Solved Help converting On Click Event to a Module

HillTJ

To train a dog, first know more than the dog..
Local time
Today, 05:44
Joined
Apr 1, 2019
Messages
731
Hi, I have the code below that enables me to copy a file to an "Archive" (I know it's spelt wrong in the code). It uses a module called 'BrowseFile' to do the look up of the file path, generates a unique file name & saves the file either in a default location (same as access installation) or a nominated location returned from a "Default" table.

Works really well but I'd like to adapt it to be a Public Module that could be used on multiple forms. Could someone assist me with some direction? Appreciate it. Also any code improvements?

Code:
Option Compare Database
Private Sub Browse_to_Photo_Click()
       
    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
   
   
    On Error GoTo ErrorHandler
   
    If (IsNull(Me.[Photo_Link]) Or Me.[Photo_Link] = "") Then 'if output record exists then close routine & exit
        strFullpath = BrowseFile ' goes to Routine that selects inpath file
        RecordNo = Me!Personel_ID
        TheTime = Time 'used to generate a unique file name
        LRandomNumber = Int((999 - 100 + 1) * Rnd + 100) 'used to generate a unique file name
   
            If IsNull(DLookup("Item_Value", "TBL_Defaults", "Item_Entity='Photo_Folder'")) Then ' returns outpath from defaults, if null selects application file path instead
                 Archieve = Application.CurrentProject.Path & "\"
            Else
                Archieve = DLookup("Item_Value", "TBL_Defaults", "Item_Entity='Photo_Folder'")
            End If
   
        Set fsFolder = CreateObject("Scripting.FileSystemObject")
        Archieve = Archieve & "\" & Year(Date)
   
            If fsFolder.FolderExists(Archieve) = False Then
                fsFolder.CreateFolder (Archieve)
            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 And Len(InPath) <= 70) 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] & "\" & "Photo" & RecordNo & Format(Now(), "ddmmyy") & Trim(Str(Hour(TheTime))) & Trim(Str(Minute(TheTime))) & Trim(Str(Second(TheTime))) & Trim(Str(LRandomNumber)) & FileExt
       
            Else
                MsgBox "File Path Length Incorrect", vbInformation, "Copy Path Incorrect"
            Exit Sub
           
            End If
                          
          Me.[Photo_Link] = OutPath 'Populates the filed & Allows the file save position to be relocated"
          FileCopy InPath, OutPath
          Me.Refresh 'to display the updated field
          MsgBox "Copied file to archives   " & vbCrLf & InPath & vbCrLf & OutPath
     Else
        MsgBox "A Photo has Already Been Copied", vbInformation, "Photo Exists-Error"
        
      End If
ExitError:
    Exit Sub
   
ErrorHandler:
  Select Case Err.Number
    Case 52
    MsgBox "Error 52-Cannot Repost", vbOKCancel
    Exit Sub
        Resume Next
    Case 76
    MsgBox "Error 76-Check File Path may not exist", vbOKCancel
    Exit Sub
        Resume Next
    Case 2302
    MsgBox "Error 2302-Check File Path may not exist", vbOKCancel
    Exit Sub
    Case Else
        Call LogError(Err.Number, Err.Description, "Browse To Photo Archive")
        Resume ExitError
    End Select

End Sub
 
Last edited by a moderator:
It's really easy actually. You want to unattach that from a form, therefore you must replace all form references with another way to obtain the data in that form. The way to do that is to pass the data to the function/sub:

Let's suppose you had a form with an input that simply put that input value in a MsgBox:

Code:
Sub ShowInputInMessageBox()
  ' shows the value in InputMessage in a Message box

  strMessage = Me!InputMessage
  ' input message

  MsgBox(strMessage)
End Sub

Now, to make that work anywhere you remove the dependence on the form and instead pass it what it needs to show in the message box:

Code:
Sub ShowInputInMessageBox(in_Message As String)
  ' shows the value in in_Message in a Message box

  MsgBox(in_Message)
End Sub

The above code doesn't reference the form at all, it simply accepts a passed value and uses that.
 
As with access there are a lot of ways if doing things @plog has a simpler way you may find simpler to implement
 
Thanks, I think I understand. Will give it a go.
 
Ok, so I've made progress & am really stoked. The routine works but does not save the string 'OutPath' to a field on 'frmPersonnel'. (I need this to navigate to the attachment later). I have a field on the form called 'Photo_Link' & it's control_Source is 'Photo_Link' . I don't need to see the "OutPath' on the form anyway. This is the form that has the control button that triggers the routine. I've highlighted the offending line with a bold italic comment

I hope I've made sense & appreciate any assistance.

EDIT: Isladogs - Added code tags

Code:
Option Compare Database
Option Explicit

Function ImportAttachment(Personel_ID As Long, Photo_Folder As String)

    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
    Dim TheTime As Date
    Dim LRandomNumber As Long
    Dim Photo_Link As String
  
        'On Error GoTo ErrorHandler
  
        strFullpath = BrowseFile ' goes to Routine that selects inpath file
        RecordNo = Personel_ID
        TheTime = Time 'used to generate a unique file name
        LRandomNumber = Int((999 - 100 + 1) * Rnd + 100) 'used to generate a unique file name
  
            If IsNull(DLookup("Item_Value", "TBL_Defaults", "Item_Entity='Photo_Folder'")) Then ' returns outpath from defaults, if null selects application file path instead
                 Archieve = Application.CurrentProject.Path & "\"
            Else
                Archieve = DLookup("Item_Value", "TBL_Defaults", "Item_Entity='Photo_Folder'")
            End If
  
        Set fsFolder = CreateObject("Scripting.FileSystemObject")
        Archieve = Archieve & "\" & Year(Date)
  
            If fsFolder.FolderExists(Archieve) = False Then
                fsFolder.CreateFolder (Archieve)
            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 And Len(InPath) <= 70) 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] & "\" & "Photo" & RecordNo & Format(Now(), "ddmmyy") & Trim(Str(Hour(TheTime))) & Trim(Str(Minute(TheTime))) & Trim(Str(Second(TheTime))) & Trim(Str(LRandomNumber)) & FileExt
      
            Else
                MsgBox "File Path Length Incorrect", vbInformation, "Copy Path Incorrect"
            Exit Function
          
            End If
                         
          Photo_Link = OutPath 'I need this to save the file & Path"
          FileCopy InPath, OutPath
        
          MsgBox "Copied file to archives   " & vbCrLf & InPath & vbCrLf & OutPath
   
   
ExitError:
    Exit Function
  
ErrorHandler:
  Select Case Err.Number
    Case 52
    MsgBox "Error 52-Cannot Repost", vbOKCancel
    Exit Function
        Resume Next
    Case 76
    MsgBox "Error 76-Check File Path may not exist", vbOKCancel
    Exit Function
        Resume Next
    Case 2302
    MsgBox "Error 2302-Check File Path may not exist", vbOKCancel
    Exit Function
    Case Else
        Call LogError(Err.Number, Err.Description, "Browse To Photo Archive")
        Resume ExitError
    End Select

End Function
 
Last edited by a moderator:
FYI - you should post anything more than a few lines of code within code tags. You can see the difference in this thread for sure (post 3). Being an old curmudgeon like I am, I see that and just move on. From past comments elsewhere, I suspect others do too - but they probably won't tell you.
 
People, I would appreciate some assistance, I don't quite follow what I need to do. If I include Forms![frmPersonnel].[Photo_Link] = OutPath in the module, it populates the field on the form but is no longer "Universal" Appreciate any help.
 
Last edited:
after this:
Photo_Link = OutPath
put this
debug.print OutPath
or put
msgbox OutPath

That should tell you if there's anything in that variable, which is what I think you're saying the issue is about. I think you should read up on how to troubleshoot vba code. I haven't checked, but I've yet to research anything without finding tons of info on it. The main reason is, we seldom can see what's going on - what the flow actually is, what the variable value is and so on. There are several techniques you can use, depending on the problem.

Also IIRC, it isn't absolutely necessary to refer to the form when the control is bound and the control and field have the same name (not sure because your way of doing it here is not one I would use) but I'm advocating the use of Me.Photo_Link (if Photo_Link is a control) otherwise I have no idea if it's a form control reference or a variable. Makes troubleshooting someone else's code more difficult.
 
Micron, Thanks for the prompt reply, done this & all works, that is the path string is returned properly to Control named 'Photo_Link' (also field name) on frmPersonnel, but to do this I had to add the line in post 9 to my module. That means that I cannot use the 'universal' module on other forms. I intend, to use the module elsewhere. Basically I do not understand how to return the 'OutPath' to the active form (I can always hide that field if necessary).
 
Last edited:
Here's the documentation for a function:


You currently have a Sub. The difference being a function returns a value. Therefore you need to change your declaration to a Function and then return the value you want. See the documentation for how to do that.
 
@HillTJ
I've added code tags to your posts #1 & #6. Please can you do so yourself in future posts
 
Plog, thanks will investigate. Isladogs, it's been a while since i last posted. I know about code tags but the forum layout seems to have changed a bit. Thanks for adding the tags. Happy to comply in future. Thanks
 
Its completely new software but a vast improvement over the old software take a bit if time to look around

Mick
 
Plog is correct that a only a function can return a value, but since the code would be in a standard module, there isn't really anything to return if what you want to do is manipulate controls on the calling form from that module. You can do that by using the correct forms collection reference; you cannot use me. You could use
Forms("formName").Controls("controlname") or perhaps Forms!formname.controlname
but since those values would be variables, I think it would have to be the former, and concatenation with the variables is tricky.

The problem that I see with a function returning a value is that AFAIK, it can only return one and you seem to need more than that. So while you can pass several parameters to the function, it can only manipulate one by way of returning values. It is also possible that you could pass the form recordset or the entire form and manipulate either from within the module.

I hope your intent is not to use the same module to manipulate multiple forms and that those forms are pretty much the same save perhaps for their recordset. That would indicate a design issue. I find it difficult to imagine where I could use code such as this on forms that are entirely different.
 
You can return more than one value but that may be over his head I.E. useing an array sting I.E. "12,14,C:\"
 
I was aware of that from prior research but wasn't going to point that out. It just seemed too complicated considering that I don't see the need to return anything if you can either manipulate either the form object or its recordset from a procedure. Then again, I don't really understand what's going on here; i.e. in what situation would I use that code against multiple forms in the same db?
 
I only included it for the OP's future reference :)
 
Last edited:
If the routine only needs to return a single value, then making it a function is probably best. I have several routines like that that I use in multiple places and that need to set/return multiple values. My solution was to name the controls consistently across all forms that use them and when calling the procedure, I pass in a form reference rather than multiple variable names.

Code:
Public Sub MySub(frm As Form)
..... some code
    frm.fld1 = calc1
    frm.fld2 = calc2
Exit sub

To call this sub use:

Call MySub(Me)

Using frm.somename is essentially the same as using me. You just have to use the same name on every form so the control named txtPath needs to be named txtPath on all the forms where you want to use this method. You can pass in additional values or even control references. If you pass in control references, the controls can have whatever names you want and they don't have to be consistent.
 

Users who are viewing this thread

Back
Top Bottom