Help with FileSearch in 2007

S

Slomaro2000

Board Regular
Joined
Jun 4, 2008
Messages
107
Hello I was wondering if you could help me out with converting this macro's FileSearch. Worked in 2003 and we upgraded to 2007 and this is not working.


Thanks

Code: 
Sub Import_txt()
'
' Import_txt Macro
' Macro recorded 1/21/2009 by Dave Michalski
'
'
    Dim sname As String
    Dim n, Rownum, counter, countfiles, countfinder, lastrow As Integer
    Dim i As Variant
    Dim fname As Variant
    Dim style, response, Searchtime, Start
    Dim Sessions As Object
    Dim System As Object
    
    
    

    
    
' Remove comment below to bypass import of data from virtal printer
'    GoTo 20
    Dim vars
    Dim vars2

    
5   Searchtime = 60        'Set search time seconds
    Start = Timer
    Rownum = 1
    lastrow = 1
       [COLOR=red] Do While Timer < Start + Searchtime
            With Application.FileSearch
            .NewSearch
            .LookIn = "[/COLOR][URL="file://\\mdnt13\g-md-virtual"][COLOR=red]\\mdnt13\g-md-virtual[/COLOR][/URL][COLOR=red]"
            .FileType = msoFileTypeAllFiles
            .Filename = "BP1M310*"
            .Execute
            
                For i = 1 To .FoundFiles.Count
                    countfiles = .FoundFiles.Count
                    fname = .FoundFiles(i)[/COLOR]
' Activate Text Importer Workbook
                    Windows("1377V Consignment Warehouse Daily Macro (MSMS I25_BATCH JOBS).xls").Activate
                    Sheets("Sheet1").Visible = True
                    Sheets("Sheet1").Select
                    
' Goto bottom of Data in text file (First run through to
                    Range("A" & Rownum).Select
                    
' Open Text File
                    Workbooks.OpenText Filename:=fname, _
                        DataType:=xlDelimited, Tab:=True
                    
                    Cells.Select
                    Selection.SpecialCells(xlCellTypeLastCell).Select
                    lastrowTXT = ActiveCell.Row
                    
' Do not include empty text files (no Consignment Issues)
                    If Selection.Value = "END OF REPORT" Then
                        ActiveWorkbook.SaveAs Filename:="[URL="file://\\Mdnt15\maint_odms\Data\MROW\Valve"]\\Mdnt15\maint_odms\Data\MROW\Valve[/URL] Program\MSMS Batch Jobs\Daily\" & Right(fname, 26)
                        ActiveWorkbook.Close SaveChanges:=False
                        GoTo 10
                    Else
                        Cells.Select
                        correp = Range("a1").Value
                        correp1 = Left(correp, 11)
                        If correp1 <> "7301-204-01" Then
                            If correp1 = "7302-151-01" Then
                             ActiveWorkbook.SaveAs Filename:="[URL="file://\\Mdnt15\maint_odms\Data\MROW\Valve"]\\Mdnt15\maint_odms\Data\MROW\Valve[/URL] Program\MSMS Batch Jobs\Monthly\" & Right(fname, 26)
'                            MONTHLYSTOCKISSUE (fname)
                            GoTo 10
                            
'                            End Sub
                            End If
                            If correp1 = "7302-156-01" Then
                            ActiveWorkbook.SaveAs Filename:="[URL="file://\\Mdnt15\maint_odms\Data\MROW\Valve"]\\Mdnt15\maint_odms\Data\MROW\Valve[/URL] Program\MSMS Batch Jobs\Monthly\" & Right(fname, 26)
                            End If
                            If correp1 = "7302-157-01" Then
                            ActiveWorkbook.SaveAs Filename:="[URL="file://\\Mdnt15\maint_odms\Data\MROW\Valve"]\\Mdnt15\maint_odms\Data\MROW\Valve[/URL] Program\MSMS Batch Jobs\Monthly\" & Right(fname, 26)
                            End If
                            If correp1 = "7302-158-01" Then
                            ActiveWorkbook.SaveAs Filename:="[URL="file://\\Mdnt15\maint_odms\Data\MROW\Valve"]\\Mdnt15\maint_odms\Data\MROW\Valve[/URL] Program\MSMS Batch Jobs\Monthly\" & Right(fname, 26)
                            End If
                            ActiveWorkbook.Close SaveChanges:=False
                            GoTo 10
                        Else
                        
' Save textfile to file share Copy / Paste from text file to Data Importer
                            ActiveWorkbook.SaveAs "[URL="file://\\Mdnt15\maint_odms\Data\MROW\Valve"]\\Mdnt15\maint_odms\Data\MROW\Valve[/URL] Program\MSMS Batch Jobs\Daily\" & Right(fname, 26)
                            Range("A1", "A" & lastrowTXT).Select
                            Selection.Copy
                            Windows("1377V Consignment Warehouse Daily Macro (MSMS I25_BATCH JOBS).xls").Activate
                            Sheets("Sheet1").Select
                            Range("A" & lastrow).Select
                            ActiveSheet.Paste
                            Windows("1377V Consignment Warehouse Daily Macro (MSMS I25_BATCH JOBS).xls").ActivatePrevious
                            ActiveWorkbook.Close SaveChanges:=False
                            Windows("1377V Consignment Warehouse Daily Macro (MSMS I25_BATCH JOBS).xls").Activate
                        End If
                    End If
' Find bottom of Text Importer Workbook
                    Cells.Select
                    Selection.SpecialCells(xlCellTypeLastCell).Select
                    lastrow = ActiveCell.Row

                    counter = 0
                    Rownum = 1
                    While counter < lastrow
                        counter = counter + 1
                        If Cells(Rownum, 1).Value = "" Then
                            Range(Rownum & ":" & Rownum).Select         'delete blank row
                            Selection.Delete Shift:=xlUp
                            Rownum = Rownum - 1
                        ElseIf Trim(Left(Cells(Rownum, 1), 16)) = "" Then
                            Range(Rownum & ":" & Rownum).Select         'delete item total / contrct total rows
                            Selection.Delete Shift:=xlUp
                            Rownum = Rownum - 1
                        End If
                            Rownum = Rownum + 1
                    Wend
                lastrow = Rownum
                Range("A" & lastrow).Select
                
                
                
                
10              Kill fname
                Next i
            End With
            If countfiles > 0 Then Exit Do
        Loop
' Error message for files not found
    If countfiles = 0 Then
        MsgBox ("File not found on Virtual Printer P00210.  Either (1) Macro had been run today or (2) file was deleted from fileshare, refer to procedure for troubeshooting.  (1) Check [URL="file://\\Mdnt15\maint_odms\Data\MROW\Valve"]\\Mdnt15\maint_odms\Data\MROW\Valve[/URL] Program\MSMS Batch Jobs\Daily for the file name BP1M310_YYYYMMDD######.txt where YYYYMMDD is yesterday's date.  (2)If the file is not found here, look in [URL="file://\\Mdnt13\g-md-virtual\~snapshot"]\\Mdnt13\g-md-virtual\~snapshot[/URL] for the file.")
        Exit Function
    Else
        For i = 1 To countfiles
            Range("A1").Select
        Next i
    End If
    
' Advisory that data has been pulled from virtual printer
'20  MsgBox ("Done pulling text file from Visual Printer, Re-organize?")
    Windows("1377V Consignment Warehouse Daily Macro (MSMS I25_BATCH JOBS).xls").Activate
    Sheets("Sheet1").Select
    Range("A1").Select
    
' Clean up text file data in excel
    While ActiveCell.Value <> ""
70      If Left(ActiveCell.Value, 4) = 7301 Then
100         ActiveCell.Offset(1, 0).Select
90          COMPANY = Trim(Mid(ActiveCell, 16, 8))
            If COMPANY <> "667" Then
80              ActiveCell.Offset(1, 0).Select
                SKIPCOM = Left(ActiveCell.Value, 7)
                If SKIPCOM <> "COMPANY" Then
                    If SKIPCOM = "" Then GoTo 60
                        GoTo 80
                    Else
                        GoTo 90
                    End If
                Else
                    ActiveCell.Offset(2, 0).Select
                    CONSICNTRCT = Trim(Mid(ActiveCell, 17, 8))
                    VENDOR = Trim(Mid(ActiveCell, 24, Len(ActiveCell)))
                    If CONSICNTRCT <> "30014" Then
                        GoTo 30
                    Else
                        ActiveCell.Offset(2, 0).Select
50                      ActiveCell.Offset(1, 0).Select
40                      If ActiveCell.Value = "" Then
                            GoTo 60
                        Else
                            test = Trim(Left(ActiveCell.Value, 5))
                            If Left(test, 3) = "COM" Then GoTo 90
                            If Left(test, 10) = "ITE" Then
'                                ActiveCell.Offset(1, 0).Select
                                GoTo 100
                            End If
                            If Left(test, 3) = "END" Then
                                ActiveCell.Offset(1, 0).Select
                                GoTo 70
                            Else
                                If test <> "" Then
                                    ItemCode = Trim(Left(ActiveCell.Value, 11))
                                    Desc = Trim(Mid(ActiveCell.Value, 12, 78))
                                    ActiveCell.Offset(1, 0).Select
                                    GoTo 40
                                Else
                                    WHSE = Trim(Left(ActiveCell.Value, 11))
                                    TRANSTYPE = Trim(Mid(ActiveCell.Value, 12, 9))
                                    If TRANSTYPE = "ISSUE" Or TRANSTYPE = "RETURN" Then
                                        TRANSDATE = Trim(Mid(ActiveCell.Value, 21, 9))
                                        REQNUM = Trim(Mid(ActiveCell.Value, 31, 8))
                                        LINEITEM = Trim(Mid(ActiveCell.Value, 40, 3))
                                        COSTCTR = Trim(Mid(ActiveCell.Value, 57, 8))
                                        Qty = Trim(Mid(ActiveCell.Value, 70, 21))
                                        Price = Trim(Mid(ActiveCell.Value, 92, 19))
                                        VALU = Trim(Mid(ActiveCell.Value, 112, 18))
                                    Else
                                        TRANSDATE = Trim(Mid(ActiveCell.Value, 21, 9))
                                        REQNUM = Trim(Mid(ActiveCell.Value, 31, 12))
                                        LINEITEM = Trim(Mid(ActiveCell.Value, 44, 2))
                                        COSTCTR = Trim(Mid(ActiveCell.Value, 57, 8))
                                        Qty = Trim(Mid(ActiveCell.Value, 70, 21))
                                        Price = Trim(Mid(ActiveCell.Value, 92, 19))
                                        VALU = Trim(Mid(ActiveCell.Value, 112, 18))
                                    End If
                                    Sheets("1377V Activity").Select
                                    Range("2:2").Select
                                    Selection.Insert Shift:=xlDown
                                    Cells(2, 1) = CONSICNTRCT
                                    Cells(2, 2) = VENDOR
                                    Cells(2, 3) = ItemCode
                                    Cells(2, 4) = Desc
                                    Cells(2, 5) = WHSE
                                    Cells(2, 6) = TRANSTYPE
                                    Cells(2, 7) = TRANSDATE
                                    Cells(2, 8) = REQNUM
                                    Cells(2, 9) = LINEITEM
                                    Cells(2, 10) = COSTCTR
                                    Cells(2, 11) = Qty
                                    Cells(2, 12) = Price
                                    Cells(2, 13) = VALU
                                    Columns("A:A").EntireColumn.AutoFit
                                    Columns("B:B").EntireColumn.AutoFit
                                    Columns("C:C").EntireColumn.AutoFit
                                    Columns("D:D").EntireColumn.AutoFit
                                    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
                                    Columns("K:K").EntireColumn.AutoFit
                                    Columns("L:L").EntireColumn.AutoFit
                                    Columns("M:M").EntireColumn.AutoFit
                                End If
                            End If
                        End If
                    End If
                End If
30          End If
            Sheets("sheet1").Select
            GoTo 50
    Wend
    
' Recreate Sheet1 to allow xlcalltypelastcell to work
60  Worksheets("Sheet1").Cells.ClearContents
    Sheets("Sheet1").Select
    ActiveWindow.SelectedSheets.Visible = False
    'ActiveWindow.SelectedSheets.Delete
    'Sheets.Add
    'ActiveSheet.Name = "Sheet1"
    Range("A1").Select
    
    Sheets("1377V Activity").Select
    bot = Range("A1").End(xlDown).Row
    Range("N2").FormulaR1C1 = _
        "=MONTH(RC[-7])"
    Range("O2").FormulaR1C1 = _
        "=YEAR(RC[-8])"
    Range("P2").Formula = _
        "=VLOOKUP(J2,'Cost Center XRef'!A:F,2,FALSE)"
    Range("Q2").Formula = _
        "=VLOOKUP(J2,'Cost Center XRef'!A:F,3,FALSE)"
    Range("R2").Formula = _
        "=VLOOKUP(J2,'Cost Center XRef'!A:F,6,FALSE)"
    Range("N2:R2").Select
    Selection.AutoFill Destination:=Range("$N2:$R" & bot)
    Range("$N2:$R" & bot).Select
    
    Sheets("1377V Activity Pivot").Select
    ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
    'ActiveSheet.PivotTables("PivotTable1").PivotSelect
    '    "'Company Code'['#N/A']", xlDataAndLabel, True
    'Selection.Interior.ColorIndex = 36
End Function
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
You must log in or register to reply here.

Similar threads

N
  • Question
Select Method of Range Class Failed with Table
Replies
4
Views
208
NorthbyNorthwest
N
F
  • Question
How to get optionbutton values from two different groups
Replies
2
Views
260
NoSparks
N
N
  • Question
Myrna Larson-Permutations and Combinations
Replies
0
Views
140
Norman A
N
G
  • Solved
Add total row with a loop
Replies
4
Views
173
gberg
G
E
  • Solved
ActiveCell vs Active range search
Replies
3
Views
235
Joe4
Joe4

Forum statistics

Threads
1,215,360
Messages
6,124,491
Members
449,166
Latest member
hokjock

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