Page 2 of 2 FirstFirst 12
Results 11 to 12 of 12

Copy VBA with a batch file

This is a discussion on Copy VBA with a batch file within the Excel Questions forums, part of the Question Forums category; Originally Posted by GTO Hope that helps, Mark This was a huge help. I was getting an error adding the ...

  1. #11
    Board Regular
    Join Date
    Apr 2011
    Location
    MA, USA
    Posts
    71

    Default Re: Copy VBA with a batch file

    Quote Originally Posted by GTO View Post
    Hope that helps,

    Mark
    This was a huge help. I was getting an error adding the code line by line because I was going over the limit but I was able to use the idea to import using "CodeModule.AddFromFile".

    It was importing to a sheet object instead of the module that was killing me and your solution is working great.

    Thanks all!

  2. #12
    GTO
    GTO is offline
    MrExcel MVP
    Join Date
    Dec 2008
    Location
    Phoenix, Arizona
    Posts
    5,079

    Default Re: Copy VBA with a batch file

    Quote Originally Posted by LCTrucido View Post
    This was a huge help. I was getting an error adding the code line by line because I was going over the limit but I was able to use the idea to import using "CodeModule.AddFromFile".

    It was importing to a sheet object instead of the module that was killing me and your solution is working great.

    Thanks all!
    Sorry about the error. I tried reproducing but could not. I am of course not sure if you have a bunch of code being inserted that you didn't include in your provided code, is that the case?

    For my own education, I tried the following:

    Code:
    Sub ImportModules_4()
    Dim objFSO          As Object ' FileSystemObject
    Dim objFolder       As Object ' Folder
    Dim f               As Object '  File
    Dim wb              As Workbook
    Dim lLRow           As Long
    Dim lRow            As Long
    Dim lCurLine        As Long
    Dim lLineCount      As Long
    Dim o_CodeModule    As Object ' CodeModule
    Dim o_vbComponent   As Object ' VBComponent
     
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        '//TESTING, change path back                                                            //
        'Set objFolder = objFSO.GetFolder("C:\Module Project\ExcelFiles")
        Set objFolder = objFSO.GetFolder(ThisWorkbook.Path & "\")
     
        For Each f In objFolder.Files
            If Not f.Path = ThisWorkbook.FullName _
            And f.Name Like "*.xls*" Then 'Just because I tested in the same folder
     
                Set wb = Workbooks.Open(f.Path, , False)
                With wb.VBProject
     
                    '// Just in case the CodeName 'Sheet1' does not exist.                      //
                    Set o_vbComponent = Nothing
                    On Error Resume Next
                    Set o_vbComponent = .VBComponents("Sheet1")
                    On Error GoTo 0
     
                    If Not o_vbComponent Is Nothing Then
     
                        Set o_CodeModule = o_vbComponent.CodeModule
     
                        o_CodeModule.AddFromString BuildReallyLongString
     
                        wb.Close True
                    Else
                        MsgBox "Unable to find the CodeName 'Sheet1' in " & wb.Name, 0, ""
                        wb.Close False
                    End If
                End With
            End If
        Next
    End Sub
     
    Function BuildReallyLongString() As String
    Dim a As String
     
    Const z = vbCrLf
    Dim x: x = Space(4)
     
    a = x & z
    a = a & "Private Sub Worksheet_Change(ByVal Target As Range)" & z
    a = a & "Dim KeyCell As Range" & z
    a = a & x & z
    a = a & "    'The variable KeyCell contains the cell that will cause an alert when it is changed." & z
    a = a & "    Set KeyCell = Range(""K1"")" & z
    a = a & x & z
    a = a & "    If Not Application.Intersect(KeyCell, Range(Target.Address)) Is Nothing Then" & z
    a = a & "        FindDuplicate" & z
    a = a & "    End If" & z
    a = a & "End Sub" & z
    a = a & x & z
    a = a & "Private Sub FindDuplicate()" & z
    a = a & "Dim ICCR As String" & z
    a = a & "Dim FoundCell As Range" & z
    a = a & x & z
    a = a & "    'The variable ICCR contains the value that will be searched for" & z
    a = a & "    ICCR = Range(""K1"").Value" & z
    a = a & x & z
    a = a & "    'Searches for the contents of the variable ICCR" & z
    a = a & "    Set FoundCell = Range(""K:K"").Find(What:=ICCR, _" & z
    a = a & "                                      After:=Range(""K1""), _" & z
    a = a & "                                      LookIn:=xlValues, _" & z
    a = a & "                                      LookAt:=xlWhole, _" & z
    a = a & "                                      SearchOrder:=xlByRows, _" & z
    a = a & "                                      SearchDirection:=xlNext, _" & z
    a = a & "                                      MatchCase:=False) ', _" & z
    a = a & "                                      SearchFormat:=False)  '<-- not in 2000" & z
    a = a & x & z
    a = a & "    'If the ICCR is not found, display a message box to the user" & z
    a = a & "    If Not FoundCell Is Nothing Then" & z
    a = a & "        If FoundCell.Address(0, 0) = ""K1"" Then" & z
    a = a & "            ActiveSheet.Range(""K1"").Select" & z
    a = a & "            MsgBox ""ICCR "" & Range(""K1"") & "" Not Found""" & z
    a = a & "            Exit Sub" & z
    a = a & x & z
    a = a & "        'If the ICCR is found, highlight the corresponding row" & z
    a = a & "        Else" & z
    a = a & "            Rows(FoundCell.Row).Select" & z
    a = a & "        End If" & z
    a = a & "    Else" & z
    a = a & "        ActiveSheet.Range(""K1"").Select" & z
    a = a & "        MsgBox ""ICCR "" & Range(""K1"") & "" Not Found""" & z
    a = a & "        Exit Sub" & z
    a = a & "    End If" & z
    a = a & "End Sub" & z
    Dim i As Long
        For i = 1 To 355
            a = a & "  'Here's a bunch of bogus commenting inserted just to suck up length, to see if we can still grab all in one shot, when sending the text to write another file blah blah balh..." & z
        Next
     
        MsgBox Len(a)
     
        BuildReallyLongString = a
    End Function
    In the above, BuildReallyLongString() [sorry about the terrible/abstract naming, but it is junk/temp code] builds a string over 65,000 chars in length that equates to over 400 lines of code. I had no problem with it and I can safely say its very doubtful to be machine related, as my poor ol' laptop with Excel2000 is "just barely electric".

    That said, I should have suggested .InsertLines if one wished to keep everything self-contained, as I cannot imagine using .AddFromString for anything but a shorter string.

    Certainly .AddFromFile is a great solution, as well as easier construct and/or maintain I am glad that worked and thank you for the feedback.

    Mark

Page 2 of 2 FirstFirst 12

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


DMCA.com