Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Wanet Telecoms Ltd on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Text File Import Macro

Status
Not open for further replies.

drace1111

Technical User
Mar 24, 2003
47
US
I am trying to create a macro that will find and import a text file based on either DateCreated or DateLastModified. Basically I'm trying to find the newest text file in a particular folder and import it. Here is the macro that I have so far:

Code:
Sub Import()
'
' Import Macro
' Macro recorded 4/8/2004
'

'
    Dim fsob As Scripting.FileSystemObject
    Dim fold As Scripting.Folder
    Dim fi As Scripting.File
    Dim x As Date
    Dim strFile As String
    Set fsob = New Scripting.FileSystemObject
    Set fold = fsob.GetFolder("k:\testing\")

    For Each fi In fold.Files
    If fi.DateLastModified > x Then
    x = fi.DateLastModified
    strFile = fi.Name
    End If
    Next
    
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;k:\testing\" & strFile, Destination:=Range("C6"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = xlWindows
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "~"
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    End With
    Columns("A:A").Select
    Selection.EntireColumn.Hidden = True
    Columns("C:C").Select
    Selection.EntireColumn.Hidden = True
    Columns("J:J").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:O").Select
    Selection.EntireColumn.Hidden = True
    Columns("P:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("Q:Q").Select
    Selection.Cut
    ActiveWindow.LargeScroll ToRight:=-1
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    Columns("R:R").Select
    Selection.Cut
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    Columns("B:B").EntireColumn.AutoFit
    Columns("B:B").ColumnWidth = 5.86
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").EntireColumn.AutoFit
    Columns("J:J").EntireColumn.AutoFit
    ActiveWindow.LargeScroll ToRight:=1
    Columns("L:L").EntireColumn.AutoFit
    Columns("L:L").EntireColumn.AutoFit
    Columns("M:M").EntireColumn.AutoFit
    Columns("N:N").EntireColumn.AutoFit
    Columns("Q:Q").EntireColumn.AutoFit
    Columns("O:O").EntireColumn.AutoFit
    Columns("Q:Q").Select
    Selection.EntireColumn.Hidden = True
    ActiveWindow.LargeScroll ToRight:=-2
    ActiveWindow.LargeScroll ToRight:=-1
End Sub

When I run this macro, no errors are reported, but nothing gets imported either. It seems like everything from "WITH" to "END WITH" is ignored. What am I missing?
 
I'm hoping to have this problem solved before the end of the day. If anyone has any suggestions, please let me know.
 
No experience in working with FileSystemObject. . . but I'd suggest you put some watches in your code. Find out what is actually being assigned to strFile in your For. . .Next loop. Perhaps the Connection property of the Querytables.Add doesn't have a valid filename to work with.

Basically, step through your code and find out specifically what is going wrong.

VBAjedi [swords]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top