Macro to find specific text in specific file name

Sunvisor

Board Regular
Joined
Oct 9, 2009
Messages
233
I have a specific directory and was able to get all the names of the files with the below code. They are now listed in column A, 1-400.

I used this code.

Code:
Sub listfiles()
Dim f As String, i As Integer
f = Dir("C:\Documents and Settings\M08040.ADNE\My Documents\Can Delete\Doug52WeekEmployee Volumes\")
i = 1
Do While Len(f) <> 0
    Cells(i, "A") = f
    f = Dir
    i = i + 1
Loop
End Sub
 
I now want to go into the directory and after Doug52WeekEmployee Volumes\ put the file name which is in A1-400...so something like Doug52WeekEmployee Volumes\A1.
 
Any ideas?..Also I then have the problem where I need it to find the specific text "Job Description:" and copy the 2 cells directly next to this word.
 
Thanks for any help guys!
 

Some videos you may like

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

Kathleen0422

Board Regular
Joined
Apr 12, 2006
Messages
188
Sheets("Files").Select
Range("A1").Select

Do While ActiveCell.Value <> ""

TheFileName = ActiveCell.Value

ActiveCell.Offset(0, 1).Select
NewFileName = ActiveCell.Value
RowSelected = Activecell.row - 1


FileCopy "C:\#####\" & TheFileName, "C:\#####\#####\" & NewFileName & " " &
RowSelected

ActiveCell.Offset(1, -1).Select

Loop
 

Sunvisor

Board Regular
Joined
Oct 9, 2009
Messages
233
I'm not exactly sure what I need to do to manipulate it, do I need to change "NewFileName" or anything also is it copying and pasting the offsetted values to a new sheet?

Thanks for the start!
 

Sunvisor

Board Regular
Joined
Oct 9, 2009
Messages
233
Also I need it to very specifically go to the first cell with "Job Description:" and copy the two cells directly to the left of this in each file
 

Kathleen0422

Board Regular
Joined
Apr 12, 2006
Messages
188
NewFileName is a variable which is being set as it loops through the list of file names.
RowSelected is the actual row you are on in the process.

I am assuming your list begins in Cell A2 with A1 being reserved for a title. This routine is not opening the files merely making a copy of them and saving them to the new location.

FileCopy "C:\Documents and Settings\M08040.ADNE\My Documents\Can Delete\Doug52WeekEmployee Volumes\" & NewFileName & "), :C:\Doug52WeekEmployee Volumes\") & NewFileName & "A" & RowSelected

Is Job Description in a set cell in every file. If so what is the cell address?
 

Sunvisor

Board Regular
Joined
Oct 9, 2009
Messages
233
it's not set I just need to find that cell somehow and then copy the two cells to the right of that word
 

Sunvisor

Board Regular
Joined
Oct 9, 2009
Messages
233
What im trying to say is I have a list A2-A400 of directory names
C:\MyDocuments....

I need a macro to go into each of these files in the folder and search for that specific word and then extract the two numbers to the right of that specific word for each and every file in that folder. I don't need to make a copy of the files or anything like that.
 

rconverse

Well-known Member
Joined
Nov 29, 2007
Messages
1,185
What about something like this? You don't need a list of your filenames.

This will go through a folder and search all Excel files for "Job Description" and return the two cells to the left.

Rich (BB code):
Sub FindTotalJobs()
Dim path As String
Dim FileName As String
Dim Wkb As Workbook
Dim wsmf As Worksheet
Dim lngLastRow1 As Long
Dim wkb1 As Workbook
Dim rng As Range
    
Call ToggleEvents(False)

    '###################################
    path = "C:\Documents and Settings\rconverse\My Documents\Test1"  'Change as needed
    '###################################
    FileName = Dir(path & "\*.xls", vbNormal)  'Change as needed (Are you looking for xls or xlsx files?)
    
    Do Until FileName = ""
        
        'this opens the workbook in the above specified folder
        Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
        
        'set this to the sheet number to look at
        Set wsmf = Wkb.Sheets(1) ' Use this line if want first sheet every time
        
        'moves to next spreadsheet if no "Job Description" is not found
        'on error goto NotFound
        
        'finds job description
        Set rng = wsmf.Cells.Find(What:="Job Description:", After:=Range("A1")).Offset(0, -2).Resize(, 2)
        rng.Copy
        
        'pastes the information in the last row of your spreadsheet
        Windows("YourSpreadsheetName.xls").Activate
        Set ws = ActiveWorkbook.Sheets(1)
        lngLastRow1 = ws.Range("A65536").End(xlUp).Row + 1
        Range("A" & lngLastRow1).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    
NotFound:

    FileName = Dir()
    
    Wkb.Close
    
    Loop

Call ToggleEvents(True)

End Sub
Sub ToggleEvents(blnState As Boolean)

'Originally written by firefytr
    
    With Excel.Application
        .DisplayAlerts = blnState
        .EnableEvents = blnState
        .ScreenUpdating = blnState
        If blnState Then .CutCopyMode = False
        If blnState Then .StatusBar = False
    End With
    
End Sub
HTH,
Roger
 

Kathleen0422

Board Regular
Joined
Apr 12, 2006
Messages
188
Sorry, didn't understand your question to begin with. Think rconverse's suggestion will do what you want.
 

Sunvisor

Board Regular
Joined
Oct 9, 2009
Messages
233
Thanks Roger, I tried it with my info and it gave me a "Compile Error: Sub or Function not defined" It's highlighting Sub "CountTotalJobs()" in yellow and highlighting Call Toggle Events too.
 

Subscribe on YouTube

Watch MrExcel Video

Forum statistics

Threads
1,105,943
Messages
5,508,273
Members
408,673
Latest member
CELER_

This Week's Hot Topics

Top