简体   繁体   中英

Excel VB for importing data from folders

I am working on a project in excel that requires importing data from files on network. The issue I am facing is as follows:

I have a folder (in shared drive) in which there are few sub-folders and an excel file in the end sub-folder. The excel file has many tabs out of which I have to import the data from only 1 particular tab (eg Summary). This process has to be repeated for all the files in all the sub-folders. Here is the flow diagram of the description.

Folder A -> Sub-folder1 -> Sub-folder2 -> {Excel file1, Excel file2}

Now, what I am looking for is, that whenever I add a new excel file in the sub-folder 2, the data from that same tab (Summary) of the excel file (all excel files have same tabs with different data) should be imported to my destination excel file and make a graph of the data. I need a VB script to run this functionality.

Also, if I have more sub-folders, then will VB take longer time to run ?

I tried the following but doesn't seem to work:

Sub ConFiles()
    Dim Wbname As String
    Dim Wb As Workbook
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim lngCalc As Long
    Dim lngrow As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        lngCalc = .CalculationState
        .Calculation = xlCalculationManual
    End With

    Set ws1 = ThisWorkbook.Sheets.Add
    'change folder path here
    FolderName = "C:\temp"
    Wbname = Dir(FolderName & "\" & "*.xls*")

    'ThisWorkbook.Sheets(1).UsedRange.ClearContents
    Do While Len(Wbname) > 0
        Set Wb = Workbooks.Open(FolderName & "\" & Wbname)
        Set ws = Nothing
        On Error Resume Next
        'change sheet name here
        Set ws = Wb.Sheets("loging form")
        On Error GoTo 0
        If Not ws Is Nothing Then
            lngrow = lngrow + 1
            ws.Rows(2).Copy ws1.Cells(lngrow, "A")
        End If
        Wb.Close False
        Wbname = Dir
    Loop

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = lngCalc
    End With
End Sub
 Function GetExcelFiles(ByVal strFilePath As String) As String()
    Dim arrStr As String() = Nothing
    If Directory.Exists(strFilePath) Then
       arrStr = GetFilePath(strFilePath)
    Else
       'error message here
    End If

    Return arrStr
End Function

Private Function GetFilePath(ByVal strFilePath As String) As String()

    Dim arrFileNames As String() = Directory.GetFiles(strFilePath, "*.xls", SearchOption.AllDirectories)
    Return arrFileNames

End Function

The code above is how to get all excel files. Next thing is... open the workbook and read per worksheet. To read file by file, you can loop using For Each .

For Each strFileName In arrStr
 'your code here
Next

where strFileName = GetExcelFiles(folderPath)

Don't forget to add Imports Microsoft.Office.Interop.Excel then

Dim excel As New Application
Dim workbook As Workbook = excel.Workbooks.Open(strFileName)

Now you have the workbook. To read per sheet, do it this way and put it in a function that returns boolean.

Dim worksheet As Worksheet
For intIndex As Integer = 1 To workbook.Sheets.Count
    worksheet = workbook.Sheets(intIndex)
    If worksheet.Name.Equals(THE_SHEETNAME) Then
        'returns true
        Exit For
    End If
Next

Now you can proceed with your process.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM