Page 1 of 2 12 LastLast
Results 1 to 15 of 19
  1. #1
    Star Lounger
    Join Date
    Mar 2012
    Posts
    78
    Thanks
    20
    Thanked 0 Times in 0 Posts

    Button with import code

    Hi

    I have the following code on a button and it is not recognizing any excel workbooks in the directory where they reside. My goal is to have the user pick the workbooks they want to import.

    Code:
    Private Sub CommandButton1_Click()
     Dim strFolder As String
       Dim strFile As String
       Dim wbkS As Workbook
       Dim wshS As Worksheet
       Dim wshT As Worksheet
       Dim lngRowS As Long
       Dim lngRowT As Long
       With Application.FileDialog(msoFileDialogFolderPicker)
         If .Show Then
           strFolder = .SelectedItems(1)
         Else
           MsgBox "No folder selected", vbExclamation
           Exit Sub
         End If
       End With
       If Right(strFolder, 1) <> "\" Then
         strFolder = strFolder & "\"
       End If
       Set wshT = ActiveSheet
       lngRowT = wshT.Cells(wshT.Rows.Count, 1).End(xlUp).Row
       Application.ScreenUpdating = False
       strFile = Dir(strFolder & "*.xls*")
       Do While strFile <> ""
         Set wbkS = Workbooks.Open(strFolder & strFile)
         Set wshS = wbkS.Worksheets(1)
         For lngRowS = 7 To 37
           If wshS.Cells(lngRowS, 1) <> "" Then
             lngRowT = lngRowT + 1
             wshT.Cells(lngRowT, 1) = wshS.Cells(lngRowS, 1) ' A
             wshT.Cells(lngRowT, 6) = wshS.Cells(lngRowS, 6) ' F
             wshT.Cells(lngRowT, 13) = wshS.Cells(lngRowS, 13) ' M
           End If
         Next lngRowS
         wbkS.Close SaveChanges:=False
         strFile = Dir
       Loop
       Application.ScreenUpdating = True
    End Sub

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,643
    Thanks
    115
    Thanked 652 Times in 594 Posts
    Jean,

    Your code is designed to let the user select a folder with Excel files, not individual files, to open and import data from 3 columns (A,F,M) from rows 7 to 37 of the first worksheet to the destination workbook hosting the code. If you want them to select A specific file then this would be more appropriate.

    Code:
    Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    '----------------------------------------
    'DECLARE AND SET VARIABLES
       Dim strFolder As String
       Dim strFile As String
       Dim wbkS As Workbook
       Dim wshS As Worksheet
       Dim wshT As Worksheet
       Dim sCurDir As String
       Dim lngRowS As Long
       Dim lngRowT As Long
       Set wshT = ActiveSheet
    '----------------------------------------
    'OPEN FILE
        sCurDir = CurDir     'GET CURRENT DIRECTORY
        ChDir ("C:\Users")  'CHANGE DIRECTORY TO DESIRED DEFAULT
        strFile = Application.GetOpenFilename  'OPEN THE DIALGUE BOX AND GET THE FILE TO OPEN
        ChDir (sCurDir)  'RESET ORIGINAL DIRECTORY
    '----------------------------------------
    'TRANSFER DATA
         Set wbkS = Workbooks.Open(strFile)
         Set wshS = wbkS.Worksheets(1)
         For lngRowS = 7 To 37
           If wshS.Cells(lngRowS, 1) <> "" Then
             lngRowT = lngRowT + 1
             wshT.Cells(lngRowT, 1) = wshS.Cells(lngRowS, 1) ' A
             wshT.Cells(lngRowT, 6) = wshS.Cells(lngRowS, 6) ' F
             wshT.Cells(lngRowT, 13) = wshS.Cells(lngRowS, 13) ' M
           End If
         Next lngRowS
    '----------------------------------------
    'CLOSE WORKBOOK AND EXIT
    wbkS.Close SaveChanges:=False
    Application.ScreenUpdating = True
    End Sub
    If this is not your intent, let us know what you want to achieve so we can help.

    Maud

  3. #3
    Star Lounger
    Join Date
    Mar 2012
    Posts
    78
    Thanks
    20
    Thanked 0 Times in 0 Posts

    Import Button with Code

    Hi Maud

    I think I need to start over. This is what I wanted to accomplish:
    I have a workbook--DDHVE.xlsm.
    I have a button that will allow me to chose a directory and import another or several workbooks (xlsm workbooks).
    I want the imported workbooks to appear after a specific sheet in the workbook DDHVE.xlsm.

    I found the following code that seemed easy enough to adjust to meet my goal but I keep getting errors. I also wanted to have the flexibility of being able to choose the directory where the imported workbooks reside.

    I hope this clearer. Appreciate the help.

    Code:
    Private Sub CommandButton1_Click()
    
    Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    directory = "d:\test\"
    fileName = Dir(directory & "*.xl*")
    
    Do While fileName <> ""
        Workbooks.Open (directory & fileName)
            
        For Each sheet In Workbooks(fileName).Worksheets
            total = Workbooks("DDHVE.xlsm").Worksheets.count
            Workbooks(fileName).Worksheets(sheet.Name).Copy _
            after:=Workbooks("DDHVE.xlsm").Worksheets(total)
        Next sheet
            
        Workbooks(fileName).Close
        fileName = Dir()
    Loop
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    End Sub

  4. #4
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,643
    Thanks
    115
    Thanked 652 Times in 594 Posts
    Hi Jean,

    A little more clearer.

    My goal is to have the user pick the workbooks they want to import.
    1. Your first posted code allows you the flexibility to pick the folder. Do you want the users to be able to pick the files within that folder?

    strFile = Dir(strFolder & "*.xls*")
    I have a button that will allow me to chose a directory and import another or several workbooks (xlsm workbooks).
    2. Do you want your users to open ay excel file or just .xlsm?
    3. Are there multiple types of files in the selected folder?

    I want the imported workbooks to appear after a specific sheet in the workbook DDHVE.xlsm.
    4. What would be the specific sheet you want the imported workbooks to appear after or is it at the end?

    5. When you say import workbook, do you mean transfer the data from the 3 columns between lines 7 and 37 inclusive from the first worksheet?

    6. is each imported worksheet supposed to have its own sheet?

    7. What are the error messages you are getting?

    Maud

  5. #5
    Star Lounger
    Join Date
    Mar 2012
    Posts
    78
    Thanks
    20
    Thanked 0 Times in 0 Posts
    Hi Maud

    1. I want the user to be able to pick the workbook within the folder.
    2. The workbooks should all be xlsm but maybe I should have xlsx available too.
    3. Each workbook could have one sheet or several sheets.
    4. I want the imported workbook sheets to appear after a sheet named "Invoice".
    5. I want all the sheets in the workbook that the user chooses. Each sheet is the same using the range A1:H50.
    6. Each imported sheet should have its own sheet.
    7. The error I get when I tried the second code I posted is:Subscript out of range.

    Jean
    Last edited by JeanM; 2015-02-23 at 10:02.

  6. #6
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Jean,

    Here's some code you can use to Select Directories and/or Filenames.

    Driver Code:
    Code:
    Option Explicit
    
    Sub MergeSelectedFile()
    
       Dim zDirectory  As String
       Dim zFileName   As String
       Dim zSaveDir    As String
       
       zSaveDir = CurDir()
       
       zDirectory = zGetDirectory("Select Directory/Folder:")
      
       If Len(zDirectory) > 0 Then
          zFileName = zGetFileName(zDirectory & "\")
          MsgBox zFileName, vbOKOnly + vbInformation, _
                 "The Select File is:"
          ChDir zSaveDir
       Else
          MsgBox "No Directory Selected!", vbOKOnly + vbCritical, _
                 "User CANCELLED!"
       End If
       
    End Sub
    Functions Called by Driver:
    Code:
    Option Explicit
    
    '                        +--------------------------+            +----------+
    '------------------------|Windows Function Type Defs|------------| 08/11/05 |
    '                        +--------------------------+            +----------+
    Public Type BROWSEINFO
        hOwner As Long
        pidlRoot As Long
        pszDisplayName As String
        lpszTitle As String
        ulFlags As Long
        lpfn As Long
        lParam As Long
        iImage As Long
    End Type
    
    '                     +-----------------------------+            +----------+
    '---------------------|Windows Function Declarations|------------| 08/11/05 |
    '                     +-----------------------------+            +----------+
    Declare Function SHGetPathFromIDList Lib "shell32.dll" _
      Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
                                    ByVal pszPath As String) As Long
                                    
    Declare Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
    
    '                         +-------------------------+            +----------+
    '-------------------------|     zGetDirectory()     |------------| 07/25/05 |
    '                         +-------------------------+            +----------+
    'Calls: N/A
    'Notes: This function will bring up a form to let the user select a directory
    
    Public Function zGetDirectory(Optional Msg) As String
    
        Dim bInfo As BROWSEINFO
        Dim zPath As String
        Dim lRetVal2 As Long, lRetVal As Long, iEndOfStr As Integer
    
        bInfo.pidlRoot = 0  '*** Root folder = Desktop ***
    
    '***   Title in the dialog ***
        If IsMissing(Msg) Then
            bInfo.lpszTitle = "Select a Drive/Directory."
        Else
            bInfo.lpszTitle = Msg
        End If
    
        bInfo.ulFlags = &H1  '*** Type of directory to return ***
        lRetVal = SHBrowseForFolder(bInfo)  '*** Display the dialog ***
        zPath = Space$(512)     '*** Parse the result ***
        lRetVal2 = SHGetPathFromIDList(ByVal lRetVal, ByVal zPath)
        If lRetVal2 Then
            iEndOfStr = InStr(zPath, Chr$(0))
            zGetDirectory = Left(zPath, iEndOfStr - 1)
        Else
            zGetDirectory = ""
        End If
        
    End Function             'zGetDirectory(Optional Msg)
    
    '                        +--------------------+                 +----------+
    '------------------------|   zGetFileName     |-----------------| 02/22/15 |
    '                        +--------------------+                 +----------+
    
    Public Function zGetFileName(Optional vInitialDir As Variant) As String
    
    'Note: This function can be called directly passing the initial directory
    '      or you can call the zGetDirectory function first to obtain the
    '      initial directory or call w/o argument to use the current directory
    '      as the starting point.
     
        Dim lngCount  As Long
        Dim dlgMyFile As FileDialog
        
        Set dlgMyFile = Application.FileDialog(msoFileDialogOpen)
           
        With dlgMyFile
        
            .AllowMultiSelect = False
            .InitialView = msoFileDialogViewDetails
            .FilterIndex = 2   'Excel Files excludes csv, xla, xhtml, etc.
    '*** Note: if the InitialFileName is a Directory it should be followed by an
    '***       ending \ to prevent the dir name showing up in the file name box.
            .InitialFileName = vInitialDir
            .Show
     
            If .SelectedItems.Count <> 0 Then _
              zGetFileName = .SelectedItems(1)
     
        End With
        
        Set dlgMyFile = Nothing
        
    End Function   'zGetFileName()
    Note: Read the comments in the function code for more info.

    Here's a test file with the driver attached to a button. VBA - Excel - Get Directory and FileName.xlsm

    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  7. The Following User Says Thank You to RetiredGeek For This Useful Post:

    JeanM (2015-02-23)

  8. #7
    Star Lounger
    Join Date
    Mar 2012
    Posts
    78
    Thanks
    20
    Thanked 0 Times in 0 Posts

    Selecting Filenames & Directories

    Hi RG

    Thank you for the code to select filenames and & directories but I need to have the workbook sheets appear in another workbook that will be open at the time when the user chooses from the folder. Maud was helping me and he asked me several questions that I hope made it clearer as to what I am trying to accomplish. I tried to take some code from two different sources and adjust but I keep getting errors. Appreciate the help and I anxiously await if Maud has the solution. Feel free if you want to tackle it too!!--never thought this would be difficult!!

    Jean

  9. #8
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Jean,

    Just replace the Driver with this:
    Code:
    Option Explicit
    
    Sub MergeSelectedFile()
    
       Dim zDirectory  As String
       Dim zFileName   As String
       Dim zSaveDir    As String
       Dim wkbMstr     As Workbook
       Dim wkbSource   As Workbook
       Dim sht         As Worksheet
       
       zSaveDir = CurDir()
       
       zDirectory = zGetDirectory("Select Directory/Folder:")
      
       If Len(zDirectory) > 0 Then
          zFileName = zGetFileName(zDirectory & "\")
          MsgBox zFileName, vbOKOnly + vbInformation, _
                 "The Select File is:"
          ChDir zSaveDir
          
          Set wkbMstr = ActiveWorkbook
          Set wkbSource = Workbooks.Open(zFileName, , True)
          
          For Each sht In wkbSource.Worksheets
             sht.Copy after:=wkbMstr.Worksheets("Invoice")
          Next sht
          
       Else
          MsgBox "No Directory Selected!", vbOKOnly + vbCritical, _
                 "User CANCELLED!"
       End If
     
       wkbSource.Close
       Set wkbSource = Nothing
       Set wkbMstr = Nothing
      
    End Sub    'MergeSelectedFiles
    Results:
    CopySheets.JPG

    Test Files: CopySheetsMaster.xlsm
    TestCopySheets.xlsx

    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  10. #9
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,832
    Thanks
    136
    Thanked 484 Times in 461 Posts
    Hi Jean, RG

    Attached is my version.
    This file has a button [browse..] which allows a folder to be selected.
    The User can specify a 'file mask' for files to be processed (e.g. "Week*.xls*" etc or simply "*.xls*"
    The files in the selected folder will then be listed.
    If the User doesn't want to process any specific file returned in the list, then just delete that row in the file list.

    Each sheet in the selected files will be appended after the last sheet.

    Hopefully, you could adapt this to meet your needs.

    zeddy
    Attached Files Attached Files

  11. #10
    Star Lounger
    Join Date
    Mar 2012
    Posts
    78
    Thanks
    20
    Thanked 0 Times in 0 Posts
    Hi RG

    Can I attach my workbooks--because I am getting confused--and you can see more clearly what I am trying to do?

    Jean
    Last edited by JeanM; 2015-02-23 at 15:01.

  12. #11
    Star Lounger
    Join Date
    Mar 2012
    Posts
    78
    Thanks
    20
    Thanked 0 Times in 0 Posts

    Import Button with Code

    Hi

    Attached are two workbooks. The Master workbook has a button without any code. I want the button to allow the user to open a workbook from a directory/folder. For this example the user chooses the workbook Checkpoints. Checkpoints workbook has 7 worksheets. I want all 7 worksheets to appear in the master workbook after the worksheet "Invoice". The master workbook will have the following worksheets--macros, invoice, ChkptTS1, ChptTS2, and so on.

    Jean
    Attached Files Attached Files

  13. #12
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Jean,

    I can't work with the Checkpoints.xlsm file because you have hidden sheets and have the vba project protected so I can't unhide them.
    I've been through 3 iterations (Macros, Cover, Instructions) and I'm not going to fight it any more. I either need the password or an unprotected file.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  14. #13
    Star Lounger
    Join Date
    Mar 2012
    Posts
    78
    Thanks
    20
    Thanked 0 Times in 0 Posts
    Hi RG

    So sorry about that. The password is HWSDUI.

    Jean

  15. #14
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Jean,

    Ok, here's a version of the Master file that works with your file.
    CopySheets.JPG
    Note: I've added a 2nd button that uses only one dialog box to select the file to merge. You can use which ever version suits your users best.

    Note 2: You'll note when you run the program that it imports the sheets in reverse order of their numbered tabs. Don't know why this happens but if it is a problem the code is going to get a lot more complicated but it can be done.

    Master File: JeanM-Master.xlsm

    HTH

    Update: I forgot to add the Application.ScreenUpdating = False statement to the two macros in the MAIN module. It isn't necessary but it will stop the screen from flashing and the macro will run a little faster. Just add it after the DIM statements.
    Last edited by RetiredGeek; 2015-02-23 at 17:01.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  16. The Following User Says Thank You to RetiredGeek For This Useful Post:

    JeanM (2015-02-23)

  17. #15
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Jean,

    Ok, here's a version that will sort the imported sheets in the correct order. I found some code on Chip Pearsons site (link address in code) to do the sorting. As I said that is more complicated as you'll see by the code that was added to the Functions module. I also had to rename your Macros tab to Buttons as the sort code will not handle a Macro sheet! Of course there is no need for a macro sheet so who cares? I also cleaned up the code organization.

    New File: JeanM-Master.xlsm

    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  18. The Following User Says Thank You to RetiredGeek For This Useful Post:

    JeanM (2015-02-23)

Page 1 of 2 12 LastLast

Posting Permissions

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