reference sheet add-in

[Snabelhund]

Hello, i have a macro that runs fine as long as i run it from a standard module. However i need to run it on several computers and tried to create an add-in. However i have problems when referencing workbooks in the code when run as add-in

Basically what the code is supposed to do is let the user select a folder that contains several workbooks, copy all the workbboks as sheets into the workbook where the code is run.

Altough i it does noot seem to work as i have a reference to "activeworkbook" which when run from a add in refereces the workbook where the same workbook that it copies from (copies the content into the next workbook that it opens instead of into the workbook where the code is run . I have tried to change it to this workbook but in that case it references the workbook where the add-in is stored instead of the actual open workbook from where the add-in code is run

Please comment if the question is unclear., to sumnmarize what i want to do i create a code that merges several workbooks into one.

See code with comments

Sub CombineFiles()
    
    Dim Path            As String
    Dim FileName        As String
    Dim Wkb             As Workbook
    Dim WS              As Worksheet
    Dim fullpath        As Variant
     With Application.FileDialog(msoFileDialogFolderPicker)
        'Makes sure the user can select only one file
        .AllowMultiSelect = False
        'Filter to just the following types of files to narrow down selection options
        '.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
        'Show the dialog box
        .Show
        
        'Store in fullpath variable
        fullpath = .SelectedItems.Item(1)
    End With
    
    
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Path = fullpath
    FileName = Dir(Path & "\*.xls", vbNormal)
    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
        For Each WS In Wkb.Worksheets
            WS.Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        Next WS
        Wkb.Close False
        FileName = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    
End Sub

 

[HaHoBe]

Hi Snabelhund,

have you considered setting a referenece to the workbook in question prior to showing the dialog and use the reference instead of ActiveWorkbook like

Sub CombineFiles_mod()
  
    Dim Path            As String
    Dim FileName        As String
    Dim Wkb             As Workbook
    Dim WS              As Worksheet
    Dim fullpath        As Variant
    Dim wkbTarget       As Workbook   'workbook to collect data
  
    Set wkbTarget = ActiveWorkbook
  
    With Application.FileDialog(msoFileDialogFolderPicker)
        'Makes sure the user can select only one file
        .AllowMultiSelect = False
        'Filter to just the following types of files to narrow down selection options
        '.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
        'Show the dialog box
        .Show
      
        'Store in fullpath variable
        fullpath = .SelectedItems.Item(1)
    End With
  
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Path = fullpath
    FileName = Dir(Path & "\*.xls", vbNormal)
    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
        For Each WS In Wkb.Worksheets
            WS.Copy After:=wkbTarget.Sheets(wkbTarget.Sheets.Count)
        Next WS
        Wkb.Close False
        FileName = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True
  
    Set wkbTarget = Nothing
  
End Sub

Ciao,
Holger

 

[Snabelhund]

Hi Holger, thanks it seems like a good idea, unfourtunatley it throws an error. It seems to be an automation error and it is thrown at the

WS.Copy After:=wkbTarget.Sheets(wkbTarget.Sheets.Count) line
i'll countinue to debug to see if i can find any more information

 

[HaHoBe]

Hi Snabelhund,

I tested the code from an add-in and a blank workbook but in this test no error was thrown. Maybe you could use On Error GoTo err_here to get the name of the workbook, the error number and description in the Immediate Window. And I spotted by now that you still use the old file format for Excel XLS. I altered the code to loop through the directory to

...Dir(Path & "\*.xls*", vbNormal)

to get both old and new workbooks.

Ciao,
Holger

 

[Snabelhund]

Hi Snabelhund,

I tested the code from an add-in and a blank workbook but in this test no error was thrown. Maybe you could use On Error GoTo err_here to get the name of the workbook, the error number and description in the Immediate Window. And I spotted by now that you still use the old file format for Excel XLS. I altered the code to loop through the directory to

...Dir(Path & "\*.xls*", vbNormal)

to get both old and new workbooks.

Ciao,
Holger

Cheers Holger i´ll look into it and report back. still learning so some of my questions might be a bit newbie-ish Sorry for that in advance

 

[Snabelhund]

Hi Snabelhund,

I tested the code from an add-in and a blank workbook but in this test no error was thrown. Maybe you could use On Error GoTo err_here to get the name of the workbook, the error number and description in the Immediate Window. And I spotted by now that you still use the old file format for Excel XLS. I altered the code to loop through the directory to

...Dir(Path & "\*.xls*", vbNormal)

to get both old and new workbooks.

Ciao,
Holger

So, i did some debugging Unfourtunately im not to familiar wih the "on error goto" But as far as i can tell the problem seems to be related to the lines

 Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
        For Each WS In Wkb.Worksheets
            WS.Copy After:=wkbTarget.Sheets(wkbTarget.Sheets.Count)
        Next WS
        Wkb.Close False

from what i can tell the the workbook that i am running the add in from seems to close when the new "source" workbook is opened.
I guess that that is the part that is creates the error, since it cant copy the contents into the target workbook.

Im thinking that perhaps it might be a good idea to write a new part of code that focuses primarly on copying contents from several workbooks into one. The code that im using right now is part of a bigger macro and my thoughts is that maybe a code for the specifik
c purpose might work better?

 

[HaHoBe]

Hi Snabelhund,

please find attached a code for using On Error like I imagine it to be used. I changed the names of the variables as I do not think it's a good idea to use a variable like FileName which is also a parameter for the Open-Dialog.

Sub CombineFiles_mod2()
 
    Dim strPath             As String
    Dim strFileName         As String
    Dim Wkb                 As Workbook
    Dim WS                  As Worksheet
    Dim wkbTarget           As Workbook   'workbook to collect data
    Dim strWB2Copy2         As String     'Full path & name of workbook data should be copied to,
                                          'needs to be saved otherwise no Path tp the workbook is available
 
    Set wkbTarget = ActiveWorkbook
    strWB2Copy2 = wkbTarget.FullName
 
    With Application.FileDialog(msoFileDialogFolderPicker)
        'Makes sure the user can select only one file
        .AllowMultiSelect = False
        'Filter to just the following types of files to narrow down selection options
        '.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
        'Show the dialog box
        If .Show = -1 Then
     
          'Store in strPath variable
          '### only it the user really made a choice
          strPath = .SelectedItems.Item(1)
        End If
    End With
 
    '### Check if a valid path is located in the string else exit sub
    If strPath = vbNullString Then Exit Sub
   
    On Error GoTo err_here
 
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    strFileName = Dir(strPath & "\*.xls*", vbNormal)
    Do Until strFileName = ""
        Set Wkb = Workbooks.Open(FileName:=strPath & "\" & strFileName)
        '### Check if the targetworkbook is still active, otherwise reopen it
        If wkbTarget Is Nothing Then Set wkbTarget = Workbooks.Open(strWB2Copy2)
        For Each WS In Wkb.Worksheets
            WS.Copy After:=wkbTarget.Sheets(wkbTarget.Sheets.Count)
        Next WS
        Wkb.Close False
        strFileName = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True
 
    Set wkbTarget = Nothing
   
    Exit Sub

err_here:
    Debug.Print strPath & strFileName
    Debug.Print Err.Number
    Debug.Print Err.Description
    Debug.Print "======"
    Resume Next
 
End Sub

Regarding the closing of the collecting workbook. You have set a reference to it and there is no command in the code to close it. Any workbook from the given directory will be referenced, opened, copied and then closed leaving the collector open. Anyhow I added a line to make sure that the collector workbook is still open before trying to copy over worksheets.

HTH,
Holger

 

[Snabelhund]

Hi Snabelhund,

please find attached a code for using On Error like I imagine it to be used. I changed the names of the variables as I do not think it's a good idea to use a variable like FileName which is also a parameter for the Open-Dialog.

Sub CombineFiles_mod2()
 
    Dim strPath             As String
    Dim strFileName         As String
    Dim Wkb                 As Workbook
    Dim WS                  As Worksheet
    Dim wkbTarget           As Workbook   'workbook to collect data
    Dim strWB2Copy2         As String     'Full path & name of workbook data should be copied to,
                                          'needs to be saved otherwise no Path tp the workbook is available
 
    Set wkbTarget = ActiveWorkbook
    strWB2Copy2 = wkbTarget.FullName
 
    With Application.FileDialog(msoFileDialogFolderPicker)
        'Makes sure the user can select only one file
        .AllowMultiSelect = False
        'Filter to just the following types of files to narrow down selection options
        '.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
        'Show the dialog box
        If .Show = -1 Then
   
          'Store in strPath variable
          '### only it the user really made a choice
          strPath = .SelectedItems.Item(1)
        End If
    End With
 
    '### Check if a valid path is located in the string else exit sub
    If strPath = vbNullString Then Exit Sub
 
    On Error GoTo err_here
 
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    strFileName = Dir(strPath & "\*.xls*", vbNormal)
    Do Until strFileName = ""
        Set Wkb = Workbooks.Open(FileName:=strPath & "\" & strFileName)
        '### Check if the targetworkbook is still active, otherwise reopen it
        If wkbTarget Is Nothing Then Set wkbTarget = Workbooks.Open(strWB2Copy2)
        For Each WS In Wkb.Worksheets
            WS.Copy After:=wkbTarget.Sheets(wkbTarget.Sheets.Count)
        Next WS
        Wkb.Close False
        strFileName = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True
 
    Set wkbTarget = Nothing
 
    Exit Sub

err_here:
    Debug.Print strPath & strFileName
    Debug.Print Err.Number
    Debug.Print Err.Description
    Debug.Print "======"
    Resume Next
 
End Sub

Regarding the closing of the collecting workbook. You have set a reference to it and there is no command in the code to close it. Any workbook from the given directory will be referenced, opened, copied and then closed leaving the collector open. Anyhow I added a line to make sure that the collector workbook is still open before trying to copy over worksheets.

HTH,
Holger

Hi again so tried running your modified code, it throws an error in each workbook that i try to copy from, in the immideate window i get the following
C:\Users\exaplefile.xlsx
Automation-error-2147221080

Also i want to thank you for helping me figuring this out, Highly appreciated! Hopefully i´ll be able to contribute to the board as my my learnig proceeds

​

 

[HaHoBe]

Hi Snabelhund,

as this is one of the errors that have more than one reason I´m afraid I can´t figure out what´s the reason for this error. Can´t be a network failure as the directory should be on the pc the code is run. The files must have got to the directory but you may have a look at the Trust Center if the directory is included there. Are the workbooks opened from the directory read-only?

Sorry, I don´t have a solution I may present to the problem.

Ciao,
Holger