vba macro for importing latest text file using delimitors

[RTLab]

How do i combine these two modules so that i import the most recent .txt file using comma delimitor?


Code 1:
Sub GetMostRecentFile()

Dim FileSys As FileSystemObject
Dim objFile As File
Dim myFolder
Dim strFilename As String
Dim dteFile As Date

'set path for files - change for your folder
Const myDir As String = "C:\Users\Admin\Documents\CDR Reports\Jan2012\TXT Files"

'set up filesys objects
Set FileSys = New FileSystemObject
Set myFolder = FileSys.GetFolder(myDir)


'loop through each file and get date last modified. If largest date then store Filename
dteFile = DateSerial(1900, 1, 1)
For Each objFile In myFolder.Files
If objFile.DateLastModified > dteFile Then
dteFile = objFile.DateLastModified
strFilename = objFile.Name
End If
Next objFile

ImportTextFile FName:=myDir & strFilename, Sep:=Chr(9)

Set FileSys = Nothing
Set myFolder = Nothing
End Sub
Public Sub ImportTextFile(FName As String, Sep As String)
Dim RowNdx As Long
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer
Application.ScreenUpdating = False
'On Error GoTo EndMacro:
SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row
Open FName For Input Access Read As #1
While Not EOF(1)
Line Input #1 , WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos >= 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
RowNdx = RowNdx + 1
Wend
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' END ImportTextFile
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub

Code 2:
Sub ImportData()
'
' ImportData Macro
'

'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\Admin\Documents\CDR Reports\Jan2012\TXT Files\I28183.txt", Destination:=Range("$A$1"))
.Name = "I28183"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

 

[pbornemeier]

Code tags are your friend. Please see link in my sig.

GetMostRecentFile finds the most recent file and calls ImportTextFile to import it
I changed Chr(9) which is the tab character to "," in the calling line
ImportTextFile FName:=myDir & strFilename, Sep:="," 'Changed separator to comma

ImportData seems to be unused, but I changed
.TextFileSpaceDelimiter = False
to False
so a space would not be used as a delimiter

Option Explicit
Sub GetMostRecentFile()
    Dim FileSys As FileSystemObject
    Dim objFile As file
    Dim myFolder
    Dim strFilename As String
    Dim dteFile As Date
    
    'set path for files - change for your folder
    Const myDir As String = "C:\Users\Admin\Documents\CDR Reports\Jan2012\TXT Files"
    
    'set up filesys objects
    Set FileSys = New FileSystemObject
    Set myFolder = FileSys.GetFolder(myDir)
    
    'loop through each file and get date last modified. If largest date then store Filename
    dteFile = DateSerial(1900, 1, 1)
    For Each objFile In myFolder.Files
       If objFile.DateLastModified > dteFile Then
           dteFile = objFile.DateLastModified
           strFilename = objFile.Name
       End If
    Next objFile
    
    ImportTextFile FName:=myDir & strFilename, Sep:="," 'Changed separator to comma
    
    Set FileSys = Nothing
    Set myFolder = Nothing
End Sub
Public Sub ImportTextFile(FName As String, Sep As String)
    Dim RowNdx As Long
    Dim ColNdx As Integer
    Dim TempVal As Variant
    Dim WholeLine As String
    Dim Pos As Integer
    Dim NextPos As Integer
    Dim SaveColNdx As Integer
    
    Application.ScreenUpdating = False
    'On Error GoTo EndMacro:
    SaveColNdx = ActiveCell.Column
    RowNdx = ActiveCell.Row
    Open FName For Input Access Read As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
    While Not EOF(1)
        Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , WholeLine
        If Right(WholeLine, 1) <> Sep Then
            WholeLine = WholeLine & Sep
        End If
        ColNdx = SaveColNdx
        Pos = 1
        NextPos = InStr(Pos, WholeLine, Sep)
        While NextPos >= 1
            TempVal = Mid(WholeLine, Pos, NextPos - Pos)
            Cells(RowNdx, ColNdx).Value = TempVal
            Pos = NextPos + 1
            ColNdx = ColNdx + 1
            NextPos = InStr(Pos, WholeLine, Sep)
        Wend
        RowNdx = RowNdx + 1
    Wend
EndMacro:
    On Error GoTo 0
    Application.ScreenUpdating = True
    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' END ImportTextFile
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 End Sub
 Code 2:
Sub ImportData()
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\Admin\Documents\CDR Reports\Jan2012\TXT Files\I28183.txt", Destination:=Range("$A$1"))
        .Name = "I28183"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False     'Changed to False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

 

[RTLab]

How do I combine these to macros so that when i import data from the most recent file, the data is imported using the importdata macro?

Option Explicit
Sub GetMostRecentFile()
    
    Dim FileSys As FileSystemObject
    Dim objFile As File
    Dim myFolder
    Dim strFilename As String
    Dim dteFile As Date
        
    'set path for files - change for your folder
    Const myDir As String = "C:\Users\Admin\Documents\CDR Reports\Jan2012\TXT Files"
    
    'set up filesys objects
    Set FileSys = New FileSystemObject
    Set myFolder = FileSys.GetFolder(myDir)
        
    
    'loop through each file and get date last modified. If largest date then store Filename
    dteFile = DateSerial(1900, 1, 1)
    For Each objFile In myFolder.Files
        If objFile.DateLastModified > dteFile Then
            dteFile = objFile.DateLastModified
            strFilename = objFile.Name
        End If
    Next objFile
       
    ImportTextFile FName:=myDir & strFilename, Sep:=","
    
    Set FileSys = Nothing
    Set myFolder = Nothing
End Sub
Public Sub ImportTextFile(FName As String, Sep As String)
Dim RowNdx As Long
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer
Application.ScreenUpdating = False
'On Error GoTo EndMacro:
SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row
Open FName For Input Access Read As #1 
While Not EOF(1)
    Line Input #1 , WholeLine
    If Right(WholeLine, 1) <> Sep Then
        WholeLine = WholeLine & Sep
    End If
    ColNdx = SaveColNdx
    Pos = 1
    NextPos = InStr(Pos, WholeLine, Sep)
    While NextPos >= 1
        TempVal = Mid(WholeLine, Pos, NextPos - Pos)
        Cells(RowNdx, ColNdx).Value = TempVal
        Pos = NextPos + 1
        ColNdx = ColNdx + 1
        NextPos = InStr(Pos, WholeLine, Sep)
    Wend
    RowNdx = RowNdx + 1
Wend
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' END ImportTextFile
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub

Sub ImportData()
'
' ImportData Macro
'

'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\Admin\Documents\CDR Reports\Jan2012\TXT Files\I28183.txt", Destination:=Range("$A$1"))
        .Name = "I28183"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

How do I combine these to macros so that when i import data from the most recent file, the data is imported using the importdata macro?

 

[pbornemeier]

This code will look for the most recent file in the coded directory (GetMostRecentFile) and open it (ImportData). The ImportTextFile sub is no longer used.

Option Explicit
Sub GetMostRecentFile()
    
    Dim FileSys As FileSystemObject
    Dim objFile As File
    Dim myFolder
    Dim strFilename As String
    Dim dteFile As Date
        
    'set path for files - change for your folder
    Const myDir As String = "C:\Users\Admin\Documents\CDR Reports\Jan2012\TXT Files"
    
    'set up filesys objects
    Set FileSys = New FileSystemObject
    Set myFolder = FileSys.GetFolder(myDir)
        
    'loop through each file and get date last modified. If largest date then store Filename
    dteFile = DateSerial(1900, 1, 1)
    For Each objFile In myFolder.Files
        If objFile.DateLastModified > dteFile Then
            dteFile = objFile.DateLastModified
            strFilename = objFile.Name
        End If
    Next objFile
    
    ImportData myDir & strFilename
    'ImportTextFile FName:=myDir & strFilename, Sep:=","
    
    Set FileSys = Nothing
    Set myFolder = Nothing
    
End Sub
'Public Sub ImportTextFile(FName As String, Sep As String)
'
'    Dim RowNdx As Long
'    Dim ColNdx As Integer
'    Dim TempVal As Variant
'    Dim WholeLine As String
'    Dim Pos As Integer
'    Dim NextPos As Integer
'    Dim SaveColNdx As Integer
'    Application.ScreenUpdating = False
'    'On Error GoTo EndMacro:
'    SaveColNdx = ActiveCell.Column
'    RowNdx = ActiveCell.Row
'    Open FName For Input Access Read As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
'    While Not EOF(1)
'        Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , WholeLine
'        If Right(WholeLine, 1) <> Sep Then
'            WholeLine = WholeLine & Sep
'        End If
'        ColNdx = SaveColNdx
'        Pos = 1
'        NextPos = InStr(Pos, WholeLine, Sep)
'        While NextPos >= 1
'            TempVal = Mid(WholeLine, Pos, NextPos - Pos)
'            Cells(RowNdx, ColNdx).Value = TempVal
'            Pos = NextPos + 1
'            ColNdx = ColNdx + 1
'            NextPos = InStr(Pos, WholeLine, Sep)
'        Wend
'        RowNdx = RowNdx + 1
'    Wend
'EndMacro:
'    On Error GoTo 0
'    Application.ScreenUpdating = True
'    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
'    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'    ' END ImportTextFile
'    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'End Sub
Sub ImportData(sFilePathNameExt As String)
'
' ImportData Macro
'
    Dim sFileName As String
    'C:\Users\Admin\Documents\CDR Reports\Jan2012\TXT Files\I28183.txt
    
    sFileName = Mid(sFilePathNameExt, InStrRev(sFilePathNameExt, "") + 1)
    sFileName = Left(sFileName, InStr(sFileName, ".") - 1)
    
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & sFilePathNameExt, Destination:=Range("$A$1"))
        .Name = sFileName
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub