Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all articles
Browse latest Browse all 88854

VBA Searching and extracting specifc line from mulitple files in folder

$
0
0

so i have this code right here that loops through a folder and the files inside, it is able to extract specified ranges e.g A18, however not all of the information i want to extract is in fixed position, how do i locate and search for string inside the file and then extract it out to my formatted table? also it occurs 2 to 3 times inside a file, and i only want to extract it once.

Option Explicit

Sub ScanFiles()

    Application.ScreenUpdating = False

    Dim wks As Worksheet
    Set wks = Worksheets.Add

    ' New worksheet for question 2
    Dim wksFSO As Worksheet

    ' Add headers data
    With wks
        .Range("A1:J1") = Array("TestP", "Temp", "Start", "Type", "FileName", "Smart")
    End With

    ' Set your copy ranges
    Dim CopyRange(1 To 4) As String
    CopyRange(1) = "A18"
    CopyRange(2) = "A14"
    CopyRange(3) = "A19"
    CopyRange(4) = "A19"' Early Binding - Add "Microsoft Scripting Runtime" Reference
    Dim FSO As New Scripting.FileSystemObject

    ' Set FolderPath
    Dim FolderPath As String
    FolderPath = "c:\Users\Desktop\Tryout\"' Set Folder FSO
    Dim Folder As Scripting.Folder
    Set Folder = FSO.GetFolder(FolderPath)

    ' Loop thru each file -> Assuming only 6 files
    Dim File As Scripting.File
    For Each File In Folder.Files

        Dim wkbData As Workbook
        Set wkbData = Workbooks.Open(File.Path)

        Dim wksData As Worksheet
        ActiveSheet.Name = "Control"
        Set wksData = wkbData.Worksheets("Control") ' -> Assume this file has only 1 worksheet

        Dim BlankRow As Long
        BlankRow = wks.Range("A"& wks.Rows.Count).End(xlUp).Row + 1

        Dim i As Long
        For i = 1 To 4
            wks.Cells(BlankRow, i).Value = wksData.Range(CopyRange(i)).Value
        Next i

        ' Write filename in col E
        wks.Cells(BlankRow, 5).Value = File.Name

        wkbData.Close False

    Next File

    Range("A:J").EntireColumn.AutoFit
    Application.ScreenUpdating = True

End Sub

Really appreciate any help regarding this issue, even a small part of a code is very appreciated.


Viewing all articles
Browse latest Browse all 88854

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>