Import TXT working with dialog... but how to import NEWEST file only?

M

manentia

New Member
Joined
Mar 1, 2008
Messages
7
I'm stuck trying to make this more automated:

Code: 
Sub Import()
    Workbooks.Add
    Filename = Application.GetOpenFilename("TXT Files (*.txt), *.txt")
    With ActiveSheet.QueryTables.Add(Connection:= _
         "TEXT;" & Filename, Destination:=Range("A1"))
        .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 = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Cells.Select
    Selection.ColumnWidth = 8
    Range("K1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$N$189").AutoFilter Field:=8, Criteria1:="TRUE"
    ActiveSheet.Range("$A$1:$N$189").AutoFilter Field:=4, Criteria1:="=32767", _
        Operator:=xlAnd
End Sub

Right now, it will open a dialog box to the default directory. After selecting the file, the macro completes.

I would like to hardcode the directory (c:\users\whatever) and have it automatically import the newest file. Is this possible?

I've read similar posts through the forum but don't know enough to modify my code myself. Big thanks in advance! :biggrin:
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Sort by date Sort by votes
stanleydgromjr said:
manentia,

This may help you.

See:
macro that identify the newest file in a folder and open it
http://groups.google.com/group/micr...ramming/browse_thread/thread/9a80a40f22b4aea0

Or:
finding last modified file in a certain folder
http://www.ozgrid.com/forum/showthread.php?t=21485


Have a great day,
Stan
Click to expand...

Thanks. I tried implementing the code from your second link and came up with this:

Code: 
Sub getlatest()
Folder = "C:\Users\Paul\Documents\"
Prefix = "dividend.yester."
First = True
Do
   If First = True Then
      Filename = Dir(Folder & "*.txt")
   Else
      Filename = Dir()
   End If
   If Filename <> "" Then
      If Filename = Left(Filename, Len(Prefix)) Then
         FileDateString = Mid(Filename, Len(Prefix) + 1)
         'remove .txt
         FileDateString = Left(FileDateString, _
            Len(FileDateString) - 4)
         'file date has a three character month followed by an extra 0
         FileDate = DateValue(Left(FileDateString, 3) & " " & _
            Mid(FileDateString, 5, 2) & " " & _
            Mid(FileDateString, 7, 4))
         If First = True Then
            LatestFile = Filename
            LatestDate = FileDate
         Else
            If FileDate > LatestDate Then
               LatestFile = Filename
               LatestDate = FileDate
            End If
         End If
      End If
   End If
   First = False
Loop While Filename <> ""
    Workbooks.Add
    With ActiveSheet.QueryTables.Add(Connection:= _
         "TEXT;" & Filename, Destination:=Range("A1"))
        .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 = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Cells.Select
    Selection.ColumnWidth = 8
    Range("K1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$N$189").AutoFilter Field:=8, Criteria1:="TRUE"
    ActiveSheet.Range("$A$1:$N$189").AutoFilter Field:=4, Criteria1:="=32767", _
        Operator:=xlAnd
End Sub

...that doesn't work. What am I doing wrong? (I get the error "The object invoked has disconnected from its clients.") Thanks again.
 
Upvote 0
Okay, I've found another helpful post and I have ALMOST got this thing to work. My problem now is that if I start the macro without an open workbook I get an error, but if I run it WITH an open workbook, it works just fine.

Is "Workbooks.Add" in the wrong place? Shouldn't that statment "open" the workbook to allow the macro to run? Thanks in advance again!!

Code: 
Sub NewImport()
    Workbooks.Add
    ChDir "C:\Users\Paul\Documents\"
    Set fs = CreateObject("scripting.Filesystemobject")
    filess = Dir("*.txt")
    While Not filess = ""
        If fs.GetFile(filess).DateLastModified > holddate Then
            holddate = fs.GetFile(filess).DateLastModified
            holdfile = filess
        End If
        filess = Dir()
    Wend
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & filess & holdfile, _
    Destination:=Range("A1"))
            .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 = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        Cells.Select
        Selection.ColumnWidth = 8
        Range("K1").Select
        Selection.AutoFilter
        ActiveSheet.Range("$A$1:$N$189").AutoFilter Field:=8, Criteria1:="TRUE"
        ActiveSheet.Range("$A$1:$N$189").AutoFilter Field:=4, Criteria1:="=32767", _
            Operator:=xlAnd
End Sub
 
Upvote 0
manentia said:
I'm stuck trying to make this more automated:

Code: 
Sub Import()
    Workbooks.Add
    Filename = Application.GetOpenFilename("TXT Files (*.txt), *.txt")
    With ActiveSheet.QueryTables.Add(Connection:= _
         "TEXT;" & Filename, Destination:=Range("A1"))
        .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 = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Cells.Select
    Selection.ColumnWidth = 8
    Range("K1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$N$189").AutoFilter Field:=8, Criteria1:="TRUE"
    ActiveSheet.Range("$A$1:$N$189").AutoFilter Field:=4, Criteria1:="=32767", _
        Operator:=xlAnd
End Sub
Right now, it will open a dialog box to the default directory. After selecting the file, the macro completes.

I would like to hardcode the directory (c:\users\whatever) and have it automatically import the newest file. Is this possible?

I've read similar posts through the forum but don't know enough to modify my code myself. Big thanks in advance! :biggrin:
Click to expand...

I had this same issue, but I used an If statement. If the data is already there, it will just refresh the query. If the data is not there, it will create it. I think it prompts you for the file because its trying to recreate the Query via VBA.

Code: 
If Range("D3IMPORT!A1").Value = "" Then
    With Sheets("D3IMPORT").QueryTables.Add(Connection:="TEXT;\\bnadsam101\prodmfg2$\D3\retail\status.txt", _
        Destination:=Range("D3IMPORT!A1"))
        .Name = "retail"
        .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 = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
Else
Range("D3IMPORT!A1").QueryTable.Refresh BackgroundQuery:=False
End If
 
Upvote 0
Success

Once I added the line in red below, everything works just super fine. This will now load the newest text file in the specified directory and import it using the criteria after the 'import section. Thanks everyone for your help and suggestions! :biggrin:

Rich (BB code): 
Sub NewImport()
    Workbooks.Add
    Worksheets("Sheet1").Activate
    'folder that will contain your files
    ChDir "C:\yourdirectory\"
    Set fs = CreateObject("scripting.Filesystemobject")
    filess = Dir("*.txt")
    While Not filess = ""
        If fs.GetFile(filess).DateLastModified > holddate Then
            holddate = fs.GetFile(filess).DateLastModified
            holdfile = filess
        End If
        filess = Dir()
    Wend
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & filess & holdfile, _
    Destination:=Range("A1"))
    'import paramaters below
            .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 = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
    'autofilter
    Cells.Select
    Selection.ColumnWidth = 8
    Range("K1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$N$189").AutoFilter Field:=8, Criteria1:="TRUE"
End Sub
 
Upvote 0
I also added the code in red from above and my script now does not give the connection error any longer. woohoo!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question Question
prompting the file selection
Replies
1
Views
182
myall_blues
myall_blues
S
  • Solved
QueryTables bug. If one query fails, all subsequent queries will fail unless restart Excel
Replies
4
Views
451
Micron
M
T
  • Solved
CSV import overwriting the next column after the last one in the CSV file
Replies
7
Views
328
Joe4
Joe4
E
  • Solved
Force Excel 2019 VBA to import multiple txt file to existing sheet & not seperate wk.book / wk.sheets
Replies
1
Views
654
Domenic
D
J
  • Question Question
Automatically import .txt files into separate sheets in Excel
Replies
1
Views
738
John_w
J

Forum statistics

Threads
1,224,600
Messages
6,179,836
Members
452,947
Latest member
Gerry_F

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top