Move WB to new Folder base on Text in File

Jlopez21887

New Member
Joined
Oct 31, 2016
Messages
8
I Have a condition where I need to check if a File contains a certain header. If the files does not contains the header "Ticket" then that file needs to be moved to a new Folder So it can be rechecked/Updated. I have most of the code written, just cannot put the finishing touches on it.

Code:
Option Explicit
Const pFolder = "C:\Users\UserA\ApplicationImport\"
Const dFolder = "C:\Users\UserA\ApplicationImport\NO_TICKET"


Sub TickerHeader()


 Dim sFile As String   [COLOR=#006400] 'file to open[/COLOR]
 Dim wbSource As Workbook, wsSource As Worksheet
 Dim HeaderCell As Range

    Application.ScreenUpdating = False
[COLOR=#008000]
[/COLOR]
[COLOR=#008000]    'loop through the Excel files in the folder:[/COLOR]
    sFile = Dir(pFolder & "*.xls*")
  Do Until sFile = ""

[COLOR=#008000]    'open the source file and set the source worksheet:[/COLOR]
    Set wbSource = Workbooks.Open(pFolder & sFile)
    Set wsSource = wbSource.ActiveSheet


  
[COLOR=#008000]    'Check to see if Src WB contains Header Value. If not move to new Folder.[/COLOR]
  
     With wsSource
[COLOR=#008000]     'Look for value in Row 1:[/COLOR]
        Set HeaderCell = Nothing
        Set HeaderCell = .Rows(1).Find(what:="Ticket*", After:=Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchFormat:=False)
        
        If HeaderCell Is Nothing Then
            MsgBox "no Ticket column header found in sheet " & wsSource.Name & " of " & wbSource.Name
            wbSource.Close SaveChanges:=False
[COLOR=#ff0000][B]            'Move File code Here[/B][/COLOR]
            sFile = Dir()
        Else
            wbSource.Close SaveChanges:=False
            sFile = Dir()
        End If
    End With
  
  Loop


'Clean up
Application.ScreenUpdating = True
Set wsSource = Nothing
Set wbSource = Nothing
Set HeaderCell = Nothing




End Sub
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Add a back slash to end of dFolder:
Code:
Const dFolder = "C:\Users\UserA\ApplicationImport\NO_TICKET\"
and to move the file:
Code:
    Name pFolder & sFile As dFolder & sFile
 
Upvote 0
Add a back slash to end of dFolder:
Code:
Const dFolder = "C:\Users\UserA\ApplicationImport\NO_TICKET\"
and to move the file:
Code:
    Name pFolder & sFile As dFolder & sFile


John I cannot believe I missed the "\." at the end of my Dest Folder. :eek:

Thank you! I appreciate it!
 
Upvote 0

Forum statistics

Threads
1,213,526
Messages
6,114,122
Members
448,550
Latest member
CAT RG

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