vba code to copy a module

[sassriverrat]

Is there a way to get a line of code that will copy a module? Idea here being that if I had a line of code that failed, I could have that module copied into a text file, saved in a temporary folder, emailed (with the text file attached), and then the recipient might be able to fix it. I know how to write the code for emailing but not the former piece.

Thanks

 

[nemmi69]

could try this

Option Explicit


Public Sub CopyModule(SourceWB As Workbook, strModuleName As String, TargetWB As Workbook)


    ' Description:  copies a module from one workbook to another
    ' example: CopyModule Workbooks(ThisWorkbook), "Module2",
    '          Workbooks("Food Specials Rolling Depot Memo 46 - 01.xlsm")
    ' Notes:   If Module to be copied already exists, it is removed first,
    '          and afterwards copied


    Dim strFolder                       As String
    Dim strTempFile                     As String
    Dim FName                           As String


    If Trim(strModuleName) = vbNullString Then
        Exit Sub
    End If


    If TargetWB Is Nothing Then
        MsgBox "Error: Target Workbook " & TargetWB.Name & " doesn't exist (or closed)", vbCritical
        Exit Sub
    End If


    strFolder = SourceWB.Path
    If Len(strFolder) = 0 Then strFolder = CurDir


    ' create temp file and copy "Module2" into it
    strFolder = strFolder & "\"
    strTempFile = strFolder & "~tmpexport.bas"


    On Error Resume Next
    FName = Environ("Temp") & "\" & strModuleName & ".bas"
    If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
        Err.Clear
        Kill FName
        If Err.Number <> 0 Then
            MsgBox "Error copying module " & strModuleName & "  from Workbook " & SourceWB.Name & " to Workbook " & TargetWB.Name, vbInformation
            Exit Sub
        End If
    End If


    ' remove "Module2" if already exits in destination workbook
    With TargetWB.VBProject.VBComponents
        .Remove .Item(strModuleName)
    End With


    ' copy "Module2" from temp file to destination workbook
    SourceWB.VBProject.VBComponents(strModuleName).Export strTempFile
    TargetWB.VBProject.VBComponents.Import strTempFile


    Kill strTempFile
    On Error GoTo 0


End Sub

Use this to call the Sub

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">[COLOR=#101094][FONT=inherit]Public[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Sub[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Main[/FONT][/COLOR][COLOR=#303336][FONT=inherit]()[/FONT][/COLOR][COLOR=#303336][FONT=inherit]

[/FONT][/COLOR][COLOR=#101094][FONT=inherit]Dim[/FONT][/COLOR][COLOR=#303336][FONT=inherit] WB1 [/FONT][/COLOR][COLOR=#101094][FONT=inherit]As[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Workbook
[/FONT][/COLOR][COLOR=#101094][FONT=inherit]Dim[/FONT][/COLOR][COLOR=#303336][FONT=inherit] WB2 [/FONT][/COLOR][COLOR=#101094][FONT=inherit]As[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Workbook

[/FONT][/COLOR][COLOR=#101094][FONT=inherit]Set[/FONT][/COLOR][COLOR=#303336][FONT=inherit] WB1 [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#303336][FONT=inherit] ThisWorkbook
[/FONT][/COLOR][COLOR=#101094][FONT=inherit]Set[/FONT][/COLOR][COLOR=#303336][FONT=inherit] WB2 [/FONT][/COLOR][COLOR=#303336][FONT=inherit]=[/FONT][/COLOR][COLOR=#303336][FONT=inherit] Workbooks[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"Food Specials Rolling Depot Memo 46 - 01.xlsm"[/FONT][/COLOR][COLOR=#303336][FONT=inherit])[/FONT][/COLOR][COLOR=#303336][FONT=inherit]

[/FONT][/COLOR][COLOR=#101094][FONT=inherit]Call[/FONT][/COLOR][COLOR=#303336][FONT=inherit] CopyModule[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#303336][FONT=inherit]WB1[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"Module2"[/FONT][/COLOR][COLOR=#303336][FONT=inherit],[/FONT][/COLOR][COLOR=#303336][FONT=inherit] WB2[/FONT][/COLOR][COLOR=#303336][FONT=inherit])[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
 [/FONT][/COLOR]</code>[COLOR=#101094][FONT=inherit]End[/FONT][/COLOR][COLOR=#303336][FONT=inherit] [/FONT][/COLOR][COLOR=#101094][FONT=inherit]Sub
[/FONT][/COLOR]

 

[sassriverrat]

hmmm...ok sorry for the delay. I've been thinking on this.

Is it possible to modify this so that it copies the selected module into a txt file?

My thought being that I have this wonderful piece of coding that puts the name of the error'd module, timestamp, and error code/description into a text file as it is

If it could do the whole module that would be perfect.

thanks

Public Sub Error_Handle(ByVal sRoutineName As String, _                         ByVal sErrorNo As String, _
                         ByVal sErrorDescription As String)
Dim sMessage As String
   sMessage = sErrorNo & " - " & sErrorDescription
   'Call MsgBox(sMessage, vbCritical, sRoutineName & " - Error")
   With UserForm18
        .Label4.Caption = sRoutineName & " [" & sMessage & "]"
        .Show
    End With
   Call LogFile_WriteError(sRoutineName, sMessage)
End Sub






Public Function LogFile_WriteError(ByVal sRoutineName As String, _
                             ByVal sMessage As String)


Dim g_objFSO As Object
Dim g_scrText As Object
Set g_objFSO = CreateObject("Scripting.FileSystemObject")
Dim sText As String
Dim errdrive As String
Dim erraddress As String
errdrive = Sheets("Developer").Range("E44")
erraddress = Sheets("Developer").Range("J44")
Dim name As String
    name = Sheets("Notes").Range("N4")


errfile = errdrive & "\" & erraddress & ".txt"
   'On Error GoTo ErrorHandler
   
   If (g_scrText Is Nothing) Then
      If (g_objFSO.FileExists(errfile) = False) Then
         Set g_scrText = g_objFSO.OpenTextFile(errfile, 2, True)
      Else
         Set g_scrText = g_objFSO.OpenTextFile(errfile, 8)
      End If
   End If
   sText = sText & "" & vbCrLf
   sText = sText & Format(Date, "dd MMM yyyy") & "-" & Time() & vbCrLf
   sText = sText & " " & sRoutineName & vbCrLf
   sText = sText & " " & sMessage & vbCrLf
   g_scrText.WriteLine sText
   g_scrText.Close
   Set g_scrText = Nothing
   Exit Function
'ErrorHandler:
   Set g_scrText = Nothing
   Call MsgBox("Unable to write to log file", vbCritical, name)
End Function

 

[nemmi69]

The file generated at this line

[COLOR=#333333]FName = Environ("Temp") & "\" & strModuleName & ".bas"[/COLOR]

is actually text that Notepad can read.

 

[Norie]

I don't think you'll be able to do that while code is running.

 

[sassriverrat]

The file generated at this line

[COLOR=#333333]FName = Environ("Temp") & "\" & strModuleName & ".bas"[/COLOR]

is actually text that Notepad can read.

So hmmm. Technically I should be able to delete the part about the second workbook and just use up to frame, agreed?

 

[sassriverrat]

@nemmi69

Good morning,

Not seeing any success making this code run....I changed the name to "Tester.xlsm" for WB2 (and made a macro-enabled workbook named "Tester" on the desktop....and changed "Module2" to one of the modules in my current workbook...to no avail

 

[sassriverrat]

hmmm no go gentlemen...