VBA help please!!! (2007)

Blueridge227

New Member
Joined
Mar 23, 2011
Messages
29
I am on a tight deadline and have searched high and low for VBA help on this, with no luck.:confused:

I have a column (E) of filenames.
2046.pdf
2057.pdf
2058.pdf ....etc

The pdf files with these filenames exist on my directory C:\Acrobat Files\

I need a Macro that will check if the files in Column E exist and mark the cell green if it does, Red if it doesn't.

An added bonus would be to create a hyperlink if the file exists as well. But not imperative.

Any help would be appreciated. Thank You!
 
Last edited:

Some videos you may like

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,277
Code:
Sub Directory_PDF_Files()

    Dim cell As Range
    
    ChDrive "C:"
    ChDir "C:\Acrobat Files"
    
    For Each cell In Range("E1", Range("E" & Rows.Count).End(xlUp))
        If Not IsEmpty(cell) Then
            If Not Dir(cell.Value) = vbNullString Then
                cell.Hyperlinks.Add cell, CurDir & "\" & cell.Value, , , cell.Value
                cell.Interior.ColorIndex = 35   ' Light green
            Else
                cell.Interior.ColorIndex = 38   ' Light red
            End If
        End If
    Next cell
    MsgBox "Process complete."
    
End Sub
 

Blueridge227

New Member
Joined
Mar 23, 2011
Messages
29
Thanks, this looks promising. However I'm getting an error 13 "type Mismatch" on:
If Not Dir(cell.Value) = vbNullString Then
 

Blueridge227

New Member
Joined
Mar 23, 2011
Messages
29
Big thanks again to AlphaFrog!
With some tweaking I've found this code to be working.
However there are sub-folders within "C:\Acrobat Files" that may contain files.

How could I tweak this code to search the subfolders as well?
Note* the sub-folder names are in Column D on my worksheet. Beside the Filenames(column E)

Sub Directory_PDF_Files()

Dim Cell As Range

ChDrive "C:"
ChDir "C:\Acrobat Files"

For Each Cell In Range("E2", Range("E" & Rows.Count).End(xlUp))
If Not IsEmpty(Cell) Then
If Not Dir(Cell.Value & ".pdf") = vbNullString Then
Cell.Hyperlinks.Add Cell, CurDir & "\" & Cell.Value & ".pdf"
Cell.Interior.ColorIndex = 35 ' Light green
Else
Cell.Interior.ColorIndex = 38 ' Light red
End If
End If

Next Cell
MsgBox "Process complete."

End Sub
 

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,277

ADVERTISEMENT

Could you give an example of your data in both D and E ?

Does column D have just a unique list of the subfolders or is it the subfolder for each file in column E

Does the column D subfolder text include "\"s or not? Be specific. It matters.
 

Blueridge227

New Member
Joined
Mar 23, 2011
Messages
29
Foldername(D) Filename(E)
2046
A1000 2057
2058
B5000 2051
A8000 548

All of the files exist in Directory (C:\Acrobat files)
But some, for example 2057 exist in sub folders within (C:\Acrobat files\A1000\2057.pdf)
 

Blueridge227

New Member
Joined
Mar 23, 2011
Messages
29

ADVERTISEMENT

Please ignore the dots.

Foldername(D)........ Filename(E)
....................................2046
A1000...........................2057
....................................2058
B5000...........................2051
A8000............................548

All of the files exist in Directory (C:\Acrobat files)
But some, for example 2057 exist in sub folders within the directory. "(C:\Acrobat files\A1000\2057.pdf)"
 

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,277
Code:
Sub Directory_PDF_Files()

    Dim cell As Range, strFile As String
    
    ChDrive "C:"
    ChDir "C:\Acrobat Files"
    
    For Each cell In Range("E1", Range("E" & Rows.Count).End(xlUp))
        If Not IsEmpty(cell) Then
        
            If IsEmpty(cell.Offset(, -1)) Then
                strFile = CurDir & "\" & cell.Value & ".pdf"
            Else
                strFile = CurDir & "\" & cell.Offset(, -1) & "\" & cell.Value & ".pdf"
            End If
                
            If Len(Dir(strFile)) Then
                cell.Parent.Hyperlinks.Add cell, strFile
                cell.Interior.ColorIndex = 35   ' Light green
            Else
                cell.Interior.ColorIndex = 38   ' Light red
            End If
        End If
    Next cell
    MsgBox "Process complete."
    
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,108,993
Messages
5,526,114
Members
409,685
Latest member
Bellybb

This Week's Hot Topics

Top