Auto Update Multiple Text Tab File In One Excel

[JERRY89]

Hi All,

I do have a problem where i will daily download my bank exchange rate in text tab file as it is only the main option given then i need to manually copy it to excel file. So can a excel file save in a folder then the monthly text tab file can be auto copy or transfer to the excel file once i downloaded the text tab file

[HansV]

Please provide more detailed information.
1) Should the text file be imported into a new worksheet in the workbook, or should it be imported into an existing sheet?
2) If it should be imported into an existing sheet, should it be appended below the existing data, or should it overwrite the existing data, or ...?

[JERRY89]

Hi Hans,

I can said that one workbook control all text tab file because i usually will download the text tab file and name it as exp:23.04.16.txt as my file name so it is a daily update report where i run from my online banking system. The example are as below link :

https://www.dropbox.com/s/l2hdrwr7e97v3 ... 6.txt?dl=0" onclick="window.open(this.href);return false;
https://www.dropbox.com/s/a3p5m9k8sil2s ... .xlsx?dl=0" onclick="window.open(this.href);return false;

[HansV]

The text file has TTS and TTB rates, but your worksheet has TTS Rate twice. What to do?

[JERRY89]

Hi Mr hans,

Sorry i keyed wrongly the data is Left is TTS and right is TTB for the excel worksheet...

[HansV]

Another error in your worksheets: columns B and C are formatted as Date, but they should be formatted as General or as Number. Please change that before running the code.

Please test the following macro on a copy of the workbook:

Code: Select all

Sub ReadTextFile()
    Dim strFile As String
    Dim lngPos As Long
    Dim arrParts() As String
    Dim lngMax As Long
    Dim lngDay As Long
    Dim lngMonth As Long
    Dim lngYear As Long
    Dim dtmDate As Date
    Dim strMonth As String
    Dim wsh As Worksheet
    Dim lngRow As Long
    Dim strLine As String
    Dim lngCol As Long
    
    With Application.FileDialog(1) ' msoFileDialogOpen
        .Filters.Clear
        .Filters.Add "Text files (*.txt)", "*.txt"
        If .Show Then
            strFile = .SelectedItems(1)
        Else
            MsgBox "You didn't select a file!", vbExclamation
            Exit Sub
        End If
    End With
    
    lngPos = InStrRev(strFile, "\")
    arrParts = Split(Mid(strFile, lngPos + 1), ".")
    lngMax = UBound(arrParts)
    If lngMax < 3 Then
        MsgBox "You didn't select a correct file!", vbExclamation
        Exit Sub
    End If
    On Error GoTo ErrHandler
    lngDay = Val(arrParts(lngMax - 3))
    lngMonth = Val(arrParts(lngMax - 2))
    lngYear = Val(arrParts(lngMax - 1))
    dtmDate = DateSerial(lngYear, lngMonth, lngDay)
    strMonth = Format(dtmDate, "mmmm'yy")
    
    On Error Resume Next
    Set wsh = Worksheets(strMonth)
    On Error GoTo ErrHandler
    If wsh Is Nothing Then
        MsgBox "Can't find the worksheet " & strMonth, vbExclamation
        Exit Sub
    End If
    
    lngMax = wsh.Cells(wsh.Rows.Count, 1).End(xlUp).Row
    For lngRow = 4 To lngMax
        If wsh.Cells(lngRow, 1).Value = dtmDate Then
            Exit For
        End If
    Next lngRow
    If lngRow > lngMax Then
        MsgBox "Can't find the date!", vbExclamation
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    Open strFile For Input As #1
    Line Input #1, strLine ' first line is skipped
    Line Input #1, strLine ' second line is skipped
    Do
        Line Input #1, strLine
        If Left(strLine, 1) = vbTab Then
            Exit Do
        End If
        arrParts = Split(strLine, vbTab)
        Select Case arrParts(0)
            Case "USD"
                lngCol = 2
            Case "EUR"
                lngCol = 3
            Case "THB"
                lngCol = 4
            Case "TWD"
                lngCol = 5
            Case "MYR"
                lngCol = 6
        End Select
        wsh.Cells(lngRow, lngCol).Value = arrParts(1)
        wsh.Cells(lngRow, lngCol + 5).Value = arrParts(3)
    Loop
    
ExitHandler:
    On Error Resume Next
    Close #1
    Application.ScreenUpdating = True
    Exit Sub
    
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

If you want to store the macro in the Monthly Exchange Rate Update workbook, please save the workbook as a macro-enabled workbook (.xlsm).

[JERRY89]

Hi Hans,

It really work great!!!but this code i have to search which text tab file to be input in so is there any ways that it can direct linked to the workbook once the text tab file is saved in the specific folder

[HansV]

That would require the code to be running continuously; that is not a good idea.

It would be possible to run code each time the workbook is opened to check for a text file in a specific folder.

[JERRY89]

Hi Hans,

Thanks a lot for your advice!!!it really work great...May i ask u something about your macro code because when i start to input this macro code in my office computer it come out error you dint select a correct file so i think it is from this macro below,can i get some of your advice

lngPos = InStrRev(strFile, "\")
arrParts = Split(Mid(strFile, lngPos + 1), ".")
lngMax = UBound(arrParts)
If lngMax < 3 Then
MsgBox "You didn't select a correct file!", vbExclamation
Exit Sub

[HansV]

You wrote that the file names are of the form 23.04.16.txt
Such a file name contains at least 3 points (dots). The error message says that the file you selected contains fewer points.

[JERRY89]

Hi Mr Hans,

Really sorry i need your advise again, because my company have changed the bank to get the daily exchange rate so the auto update file can't work properly as the text tab file have changed format,may i get your guidance.

https://www.dropbox.com/s/l2hdrwr7e97v3 ... 6.txt?dl=0" onclick="window.open(this.href);return false;

https://www.dropbox.com/s/27xtf9f0hh2a3 ... .xlsm?dl=0" onclick="window.open(this.href);return false;

[HansV]

Apart from the change in layout of the text file, you also changed the layout of the worksheet

Code: Select all

Sub ReadTextFile()
    Dim strFile As String
    Dim lngPos As Long
    Dim arrParts() As String
    Dim lngMax As Long
    Dim lngDay As Long
    Dim lngMonth As Long
    Dim lngYear As Long
    Dim dtmDate As Date
    Dim strMonth As String
    Dim wsh As Worksheet
    Dim lngRow As Long
    Dim strLine As String
    Dim lngCol As Long
    Dim i As Long
   
    With Application.FileDialog(1) ' msoFileDialogOpen
        .Filters.Clear
        .Filters.Add "Text files (*.txt)", "*.txt"
        If .Show Then
            strFile = .SelectedItems(1)
        Else
            MsgBox "You didn't select a file!", vbExclamation
            Exit Sub
        End If
    End With
   
    lngPos = InStrRev(strFile, "\")
    arrParts = Split(Mid(strFile, lngPos + 1), ".")
    lngMax = UBound(arrParts)
    If lngMax < 3 Then
        MsgBox "You didn't select a correct file!", vbExclamation
        Exit Sub
    End If
    On Error GoTo ErrHandler
    lngDay = Val(arrParts(lngMax - 3))
    lngMonth = Val(arrParts(lngMax - 2))
    lngYear = Val(arrParts(lngMax - 1))
    dtmDate = DateSerial(lngYear, lngMonth, lngDay)
    strMonth = Format(dtmDate, "mmmm'yy")
   
    On Error Resume Next
    Set wsh = Worksheets(strMonth)
    On Error GoTo ErrHandler
    If wsh Is Nothing Then
        MsgBox "Can't find the worksheet " & strMonth, vbExclamation
        Exit Sub
    End If
   
    lngMax = wsh.Cells(wsh.Rows.Count, 1).End(xlUp).Row
    For lngRow = 4 To lngMax
        If wsh.Cells(lngRow, 1).Value = dtmDate Then
            Exit For
        End If
    Next lngRow
    If lngRow > lngMax Then
        MsgBox "Can't find the date!", vbExclamation
        Exit Sub
    End If
   
    Application.ScreenUpdating = False
   
    Open strFile For Input As #1
    For i = 1 To 7
        Line Input #1, strLine ' skip the first 7 lines
    Next i

    Do
        Line Input #1, strLine
        If strLine = "" Then
            Exit Do
        End If
        arrParts = Split(Application.Trim(strLine))
        Select Case arrParts(0)
            Case "USD"
                lngCol = 2
            Case "EUR"
                lngCol = 3
            Case "TWD"
                lngCol = 4
            Case "THB"
                lngCol = 5
            Case "MYR"
                lngCol = 6
            Case Else
                lngCol = 9999
        End Select
        If lngCol < 9999 Then
            wsh.Cells(lngRow, lngCol).Value = arrParts(1)
            wsh.Cells(lngRow, lngCol + 5).Value = arrParts(2)
        End If
    Loop
   
ExitHandler:
    On Error Resume Next
    Close #1
    Application.ScreenUpdating = True
    Exit Sub
   
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

[JERRY89]

Hi Hans,

You are really very great!!!!totally a perfect solution..thanks alot