View Single Post
  #20   Report Post  
Posted to microsoft.public.excel.programming
Jim Cone Jim Cone is offline
external usenet poster
 
Posts: 3,290
Default Putting A Macro in a Cell


Thanks for the update.
I was going to ask for the results as the problem did puzzle me.
Much appreciated.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)



"JLatham"
<HelpFrom @ Jlathamsite.com.(removethis)
wrote in message
Jim,
Just to let you know how things went - it's a done deal now and code is
working for him, but not as a UDF - as an "on demand" Sub. The basic problem
of all of our earlier efforts is that Excel seems to play games with
hyperlinks inserted using Insert | Hyperlink. It will sometimes change them
to a relative link as "..\..\folder\folder\file.xxx" and will sometimes put
them in as something like
"file:///\folder\file.xxx" and sometimes even reverse the \ to /. This was
confusing the FileDateTime() command and causing the #VALUE error returns.

I took the code I'd written earlier using the FSO and what you initially
provided and got rid of the use of FSO, since FileDateTime() gave me what we
needed without using scripting and FSO, and wrote code that dealt with both
types of hyperlinks: those contained within a =HYPERLINK() worksheet
function, and those inserted with Insert | Hyperlink. BUT - for the second
type, since he has all of the files in a known location on the system, I
first replaced any / characters with \ then stripping off just the filename
and prefacing it with the known folder path. I then used that path as the
argument for FileDateTime() and he says it's working just fine for him now.
The final code:

Sub GetFileDates()
'
'change these constants to match your setup
Const WSheet = "Activity" ' be sure to change this in your workbook if
needed
Const pathToFiles = "C:\mcam\Work Log\Activity\" ' my test path:
"C:\Documents and Settings\All Users\Documents\Proposals\AcademyInstr_Rebid\"
'"C:\mcam\Work Log\Activity\"
Const linkColumn = "E"
Const dateColumn = "H"
Const firstDataRow = 2 ' first row to examine for hyperlinks.

Dim dateColOffset As Integer
Dim anyAddress As String
Dim allLinkCells As Range
Dim anyCell As Range
Dim lastRow As Long
Dim LC As Integer ' loop counter
Dim anyLink As String ' this was P in the When() function
Dim filesDate As Date ' this was T in the When() function

'some preparation setup
lastRow = Range(linkColumn & Rows.Count).End(xlUp).Row
If lastRow <= firstDataRow Then
MsgBox "No possible hyperlinks to examine. Quitting.", vbOKOnly, "No
Data Entries"
Exit Sub
End If
dateColOffset = Range(dateColumn & firstDataRow).Column - _
Range(linkColumn & firstDataRow).Column
anyAddress = linkColumn & firstDataRow & ":" & linkColumn & lastRow
'reference all used cells in column E
Set allLinkCells = Worksheets(WSheet).Range(anyAddress)

'work through all possible links on the sheet/column E
For Each anyCell In allLinkCells
If anyCell.Hyperlinks.Count < 1 Then
'test for =HYPERLINK formula
If anyCell.HasFormula Then
If Left(anyCell.Formula, 10) = "=HYPERLINK" Then
anyLink = Mid(anyCell.Formula, 13, _
InStr(13, anyCell.Formula, Chr$(34)) - 13)
On Error Resume Next
filesDate = FileDateTime(anyLink)
If Err = 0 Then
anyCell.Offset(0, dateColOffset) = Format$(filesDate, "General
Date")
Else
anyCell.Offset(0, dateColOffset) = "Invalid Link Path"
Err.Clear
End If
On Error GoTo 0
Else
anyCell.Offset(0, dateColOffset) = ""
End If
Else
anyCell.Offset(0, dateColOffset) = ""
End If
Else
anyLink = anyCell.Hyperlinks(1).Address
'we are going to take ALL hyperlinks and reduce them
'to just the filename and add the contents of pathToFiles back to them!
'make sure that / gets changed to \ in it first
anyLink = Replace(anyLink, "/", Application.PathSeparator)
anyLink = pathToFiles & Right(anyLink, Len(anyLink) - _
InStrRev(anyLink, Application.PathSeparator))

On Error Resume Next
filesDate = FileDateTime(anyLink)
If Err = 0 Then
anyCell.Offset(0, dateColOffset) = Format$(filesDate, "General Date")
Else
anyCell.Offset(0, dateColOffset) = "Invalid Link Path"
Err.Clear
End If
On Error GoTo 0
End If
Next ' end of anyCell in allLinkCells loop
End Sub