Read and import K and S database

[wwj]

Read and import K and S database, exported from GWV

Code: Select all

Sub Read_Import_K_S_Database_FromFile()
'
'  Read K and S database exported from GWV
'   Verified!
'
    Dim fso As Object
    Dim ts As Object
    Dim dict As Object
    
    Dim filePath As String
    Dim inFN(1 To 2) As String
    
    Dim line As String
    Dim parts As Variant
    Dim zone As String
    
    Dim wsKSdb As Worksheet
    Dim key As Variant
    Dim rowNum As Long
    Dim headerCol As Integer
    
    '   Parameters.
    folderNm = Worksheets("macro").Cells(6, "D")
    inFN(1) = Worksheets("macro").Cells(7, "E")     ' Data file name.
    inFN(2) = Worksheets("macro").Cells(8, "E")     ' Data file name.
    
    Set wsKSdb = ThisWorkbook.Sheets("KSdb")
    wsKSdb.Range("B1:F1000").ClearContents       ' colums for the K database.
    wsKSdb.Range("I1:M1000").ClearContents       ' colums for the S database.
    
    For loopKS = 1 To 2
    
        '=== 1. Set file path ===
        filePath = ActiveWorkbook.Path & "\" & folderNm & "\" & inFN(loopKS)
        
        '=== 2. Create objects ===
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set ts = fso.OpenTextFile(filePath, 1) '              1 = ForReading
        Set dict = CreateObject("Scripting.Dictionary")
        
        '=== 3. Read line-by-line ===
        outRow = 1 '
        
        If loopKS = 1 Then
            colOut = 2      ' column B
        Else
            colOut = 9      ' column I
        End If
        
        headerCol = 1
        
        Do While Not ts.AtEndOfStream
            line = ts.ReadLine
            If Len(line) > 0 Then
                ' Normalize spaces and split
                'parts = Split(line, vbTab) ' change vbTab to "," if CSV
                parts = Split(Application.Trim(line), " ")
                
                ' Copy up to 5 columns into worksheet
                If UBound(parts) >= 0 Then ' 0-based index (0 to 4 = 5 columns)
                    For i = 0 To UBound(parts)
                        wsKSdb.Cells(outRow, colOut + i + headerCol) = parts(i)
                    Next i
                    
                    outRow = outRow + 1
                    
                    If headerCol = 1 Then
                        headerCol = 0
                    End If
                    
                End If
            End If
        Loop
        ts.Close
    
    Next loopKS
    
    MsgBox "Done!"
    
End Sub