Hi there... am posting this again... perhaps got overlooked the first time.

I have an excel spreadsheet that has more than 500 different hyperlinks to
500 different emails stored in another folder. Now as soon as the number of
emails exceed 100, I create a new sub-folder and move the already-linked
emails
into the sub-folder thus losing all the linkings. Is there a way to avoid
losing
the linkings... isn't there a way to hyperlink a document so that the link
is not
lost even if the linked document is moved?

Thanks

Raj

Give this a shot. It will change the path of all hyperlinks in the selected
range to a single new path.
Test using a back up first.

'/===============================================/
'32-bit API declarations
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long

'/===============================================/
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'/===============================================/

Sub HyperlinkChangeLinkPath()
' Change path of all hyperlinks in range to a single new path
' If there is no 'address', then the path does not get changed
'
' Gary L. Brown
' Kinneson Consulting
' www.kinneson.com
' 12/18/2001
'
Dim h As Hyperlink
Dim i As Integer, iCount As Integer
Dim x As Integer, y As Integer
Dim rngInput As Range
Dim strInputBox As String, strMsg As String
Dim strAnchor As String, strOriginalAddress As String
Dim strSubAddress As String, strAddress As String
Dim strName As String, strParent As String
Dim strTextToDisplay As String
Dim varAnswer As Variant

On Error Resume Next

'test if back up was performed prior to running this macro
varAnswer = _
MsgBox( _
"If you have NOT Backed up this workbook prior to this processing" _
& vbCr & " select CANCEL and perform backup, otherwise" & _
vbCr & " select OK to continue.", _
vbExclamation + vbOKCancel + vbDefaultButton1, "Warning Prior to
Processing... www.kinneson.com")

If varAnswer < vbOK Then
MsgBox "The user has canceled this process..." & vbCr & _
"Process halted.", vbCritical + vbOKOnly, "Warning..."
GoTo exit_Sub
End If

'store current selection in a variable
strOriginalAddress = Selection.Address

'get range containing hyperlinks to be changed
Set rngInput = _
Application.InputBox(Prompt:= _
"Select Range of Hyperlink cells to be changed", _
Title:="Select Range of hyperlinks.... www.kinneson.com", _
Default:=strOriginalAddress, Type:=8)

' Count the # of hyperlinks in the selected range
i = rngInput.Hyperlinks.Count

If i = 0 Then
MsgBox "No cells with hyperlinks have been selected.", _
vbExclamation + vbOKOnly, _
"Warning... Processed halted... www.kinneson.com"
GoTo exit_Sub
End If

'give choices of how to enter new hyperlink path
varAnswer = _
MsgBox("Yes - 'Browse/Point-and-Click' at a Drive/Folder" & _
vbCr & "No - 'Type in' new Hyperlink path" & _
vbCr & "Cancel - Halt this process", _
vbInformation + vbYesNoCancel + vbDefaultButton1, _
"Select an Action [Yes/No/Cancel]... www.kinneson.com")

Select Case varAnswer
Case vbYes
strMsg = _
" Select location of Hyperlink path or press Cancel."
strInputBox = GetDirectory(strMsg)
If strInputBox = "" Then
MsgBox "A folder has not been selected..." & vbCr & _
"Process halted.", vbCritical + vbOKOnly, "Warning..."
GoTo exit_Sub
End If
If Right(strInputBox, 1) < "\" Then strInputBox = strInputBox & "\"

Case vbNo
strInputBox = _
InputBox(" Enter location of Hyperlink path or press Cancel." & _
vbCrLf & vbCrLf & "NOTES:" & vbCrLf & _
" If you are entering a URL, you MUST end" & _
vbCrLf & " the entry with a back-slash (/) or the hyperlink" & _
vbCrLf & " will not work correctly..." & vbCrLf & vbCrLf & _
" If you are entering a file path, you MUST end" & _
vbCrLf & " the entry with a forward-slash (\) or the hyperlink" & _
vbCrLf & " will not work correctly...", _
"Enter a valid path... www.kinneson.com")
If strInputBox = "" Then
MsgBox "A folder has not been entered..." & vbCr & _
"Process halted.", vbCritical + vbOKOnly, "Warning..."
GoTo exit_Sub
End If

Case vbCancel
MsgBox "The user has canceled this process..." & vbCr & _
"Process halted.", vbCritical + vbOKOnly, "Warning..."
GoTo exit_Sub

Case Else
MsgBox "Unexpected Error..." & vbCr & _
"Process halted.", vbCritical + vbOKOnly, "Warning..."
GoTo exit_Sub
End Select

' go through each hyperlink in the range and change path
For Each h In rngInput.Hyperlinks
' put the hyperlink's info into variables
' get range
strAnchor = h.Range.Address

'get address
strAddress = h.Address
If Len(h.Address) = 0 Then
strAddress = ""
Else
If Right(Trim(h.Address), 1) = "/" Then
strAddress = strInputBox
Else
If FindSlash(h.Address) < 0 Then
strAddress = strInputBox & _
Right(h.Address, Len(h.Address) - FindSlash(h.Address))
End If
End If
End If

'get sub-address
strSubAddress = h.SubAddress

'get name & parent & text-to-display
If Len(strAddress) < 0 Then
If Len(strSubAddress) < 0 Then
strName = strAddress & " - " & strSubAddress
strParent = strName
strTextToDisplay = strName
Else
strName = strAddress
strParent = strAddress
strTextToDisplay = strAddress
End If
Else
If Len(strSubAddress) < 0 Then
strName = strSubAddress
strParent = _
Right(h.SubAddress, _
Len(h.SubAddress) - InStr(1, h.SubAddress, "!"))
strTextToDisplay = strParent
Else
strName = h.name
strParent = h.Parent
strTextToDisplay = h.TextToDisplay
End If
End If

' change the hyperlink's info
With h
.Range = strAnchor
.Address = strAddress
.SubAddress = strSubAddress
.Parent = strParent
.TextToDisplay = strTextToDisplay
End With
Next h

exit_Sub:
Set rngInput = Nothing

End Sub
'/===============================================/

Private Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim iFileSystemDirectoriesOnly As Long
Dim iDialogType As Long
Dim iBrowseForComputers As Long
Dim iBrowseForPrinters As Long
Dim iBrowseIncludesFiles As Long
Dim Path As String
Dim r As Long, x As Long, Pos As Integer

iFileSystemDirectoriesOnly = 0
iDialogType = 0
iBrowseForComputers = 0
iBrowseForPrinters = 0
iBrowseIncludesFiles = 0
'- - - - - - - - - - - - - - - - -
'Only return file system directories.
iFileSystemDirectoriesOnly = &H1
'Dialog style with context menu and resizability
iDialogType = &H40
'Only returns computers
iBrowseForComputers = &H1000
'Only return printers
iBrowseForPrinters = &H2000
'The browse dialog will display files as well as folders
iBrowseIncludesFiles = &H4000

' Root folder = Desktop
bInfo.pidlRoot = 0&

' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If

' Type of directory to return
bInfo.ulFlags = _
iFileSystemDirectoriesOnly + _
iDialogType + _
iBrowseForComputers + _
iBrowseForPrinters + _
iBrowseIncludesFiles

' Display the dialog
x = SHBrowseForFolder(bInfo)

' Parse the result
Path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal Path)
If r Then
Pos = InStr(Path, Chr$(0))
GetDirectory = Left(Path, Pos - 1)
Else
GetDirectory = ""
End If
End Function
'/===============================================/
Private Function FindSlash(strFullPath As String) As Integer
Dim ix As Integer, iy As Integer

FindSlash = 0

For ix = Len(strFullPath) To 1 Step -1
If Mid(strFullPath, ix, 1) = "\" Or _
Mid(strFullPath, ix, 1) = "/" Then
FindSlash = ix
Exit For
End If
Next ix

End Function
'/===============================================/


HTH,
--
Gary Brown

If this post was helpful, please click the ''Yes'' button next to ''Was this
Post Helpfull to you?''.


"Raj Mazumdar" wrote:

Hi there... am posting this again... perhaps got overlooked the first time.

I have an excel spreadsheet that has more than 500 different hyperlinks to
500 different emails stored in another folder. Now as soon as the number of
emails exceed 100, I create a new sub-folder and move the already-linked
emails
into the sub-folder thus losing all the linkings. Is there a way to avoid
losing
the linkings... isn't there a way to hyperlink a document so that the link
is not
lost even if the linked document is moved?

Thanks

Raj

Thanks Gary, for the effort but this goes into the VB Macro, right? Tried
copy-pasting it there and moved the linked emails into a different folder but
the links are getting lost... am I doing something wrong? Also my document
already consists of over 500 links... putting the macro in, would it upset
all the links there? If it does, it might turn out to be a little difficult
to be workable for me... re-establishing 500 links would be cumbersome...

Thanks again

Raj

"Gary L Brown" wrote:

Give this a shot. It will change the path of all hyperlinks in the selected
range to a single new path.
Test using a back up first.

'/===============================================/
'32-bit API declarations
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long

'/===============================================/
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'/===============================================/

Sub HyperlinkChangeLinkPath()
' Change path of all hyperlinks in range to a single new path
' If there is no 'address', then the path does not get changed
'
' Gary L. Brown
' Kinneson Consulting
' www.kinneson.com
' 12/18/2001
'
Dim h As Hyperlink
Dim i As Integer, iCount As Integer
Dim x As Integer, y As Integer
Dim rngInput As Range
Dim strInputBox As String, strMsg As String
Dim strAnchor As String, strOriginalAddress As String
Dim strSubAddress As String, strAddress As String
Dim strName As String, strParent As String
Dim strTextToDisplay As String
Dim varAnswer As Variant

On Error Resume Next

'test if back up was performed prior to running this macro
varAnswer = _
MsgBox( _
"If you have NOT Backed up this workbook prior to this processing" _
& vbCr & " select CANCEL and perform backup, otherwise" & _
vbCr & " select OK to continue.", _
vbExclamation + vbOKCancel + vbDefaultButton1, "Warning Prior to
Processing... www.kinneson.com")

If varAnswer < vbOK Then
MsgBox "The user has canceled this process..." & vbCr & _
"Process halted.", vbCritical + vbOKOnly, "Warning..."
GoTo exit_Sub
End If

'store current selection in a variable
strOriginalAddress = Selection.Address

'get range containing hyperlinks to be changed
Set rngInput = _
Application.InputBox(Prompt:= _
"Select Range of Hyperlink cells to be changed", _
Title:="Select Range of hyperlinks.... www.kinneson.com", _
Default:=strOriginalAddress, Type:=8)

' Count the # of hyperlinks in the selected range
i = rngInput.Hyperlinks.Count

If i = 0 Then
MsgBox "No cells with hyperlinks have been selected.", _
vbExclamation + vbOKOnly, _
"Warning... Processed halted... www.kinneson.com"
GoTo exit_Sub
End If

'give choices of how to enter new hyperlink path
varAnswer = _
MsgBox("Yes - 'Browse/Point-and-Click' at a Drive/Folder" & _
vbCr & "No - 'Type in' new Hyperlink path" & _
vbCr & "Cancel - Halt this process", _
vbInformation + vbYesNoCancel + vbDefaultButton1, _
"Select an Action [Yes/No/Cancel]... www.kinneson.com")

Select Case varAnswer
Case vbYes
strMsg = _
" Select location of Hyperlink path or press Cancel."
strInputBox = GetDirectory(strMsg)
If strInputBox = "" Then
MsgBox "A folder has not been selected..." & vbCr & _
"Process halted.", vbCritical + vbOKOnly, "Warning..."
GoTo exit_Sub
End If
If Right(strInputBox, 1) < "\" Then strInputBox = strInputBox & "\"

Case vbNo
strInputBox = _
InputBox(" Enter location of Hyperlink path or press Cancel." & _
vbCrLf & vbCrLf & "NOTES:" & vbCrLf & _
" If you are entering a URL, you MUST end" & _
vbCrLf & " the entry with a back-slash (/) or the hyperlink" & _
vbCrLf & " will not work correctly..." & vbCrLf & vbCrLf & _
" If you are entering a file path, you MUST end" & _
vbCrLf & " the entry with a forward-slash (\) or the hyperlink" & _
vbCrLf & " will not work correctly...", _
"Enter a valid path... www.kinneson.com")
If strInputBox = "" Then
MsgBox "A folder has not been entered..." & vbCr & _
"Process halted.", vbCritical + vbOKOnly, "Warning..."
GoTo exit_Sub
End If

Case vbCancel
MsgBox "The user has canceled this process..." & vbCr & _
"Process halted.", vbCritical + vbOKOnly, "Warning..."
GoTo exit_Sub

Case Else
MsgBox "Unexpected Error..." & vbCr & _
"Process halted.", vbCritical + vbOKOnly, "Warning..."
GoTo exit_Sub
End Select

' go through each hyperlink in the range and change path
For Each h In rngInput.Hyperlinks
' put the hyperlink's info into variables
' get range
strAnchor = h.Range.Address

'get address
strAddress = h.Address
If Len(h.Address) = 0 Then
strAddress = ""
Else
If Right(Trim(h.Address), 1) = "/" Then
strAddress = strInputBox
Else
If FindSlash(h.Address) < 0 Then
strAddress = strInputBox & _
Right(h.Address, Len(h.Address) - FindSlash(h.Address))
End If
End If
End If

'get sub-address
strSubAddress = h.SubAddress

'get name & parent & text-to-display
If Len(strAddress) < 0 Then
If Len(strSubAddress) < 0 Then
strName = strAddress & " - " & strSubAddress
strParent = strName
strTextToDisplay = strName
Else
strName = strAddress
strParent = strAddress
strTextToDisplay = strAddress
End If
Else
If Len(strSubAddress) < 0 Then
strName = strSubAddress
strParent = _
Right(h.SubAddress, _
Len(h.SubAddress) - InStr(1, h.SubAddress, "!"))
strTextToDisplay = strParent
Else
strName = h.name
strParent = h.Parent
strTextToDisplay = h.TextToDisplay
End If
End If

' change the hyperlink's info
With h
.Range = strAnchor
.Address = strAddress
.SubAddress = strSubAddress
.Parent = strParent
.TextToDisplay = strTextToDisplay
End With
Next h

exit_Sub:
Set rngInput = Nothing

End Sub
'/===============================================/

Private Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim iFileSystemDirectoriesOnly As Long
Dim iDialogType As Long
Dim iBrowseForComputers As Long
Dim iBrowseForPrinters As Long
Dim iBrowseIncludesFiles As Long
Dim Path As String
Dim r As Long, x As Long, Pos As Integer

iFileSystemDirectoriesOnly = 0
iDialogType = 0
iBrowseForComputers = 0
iBrowseForPrinters = 0
iBrowseIncludesFiles = 0
'- - - - - - - - - - - - - - - - -
'Only return file system directories.
iFileSystemDirectoriesOnly = &H1
'Dialog style with context menu and resizability
iDialogType = &H40
'Only returns computers
iBrowseForComputers = &H1000
'Only return printers
iBrowseForPrinters = &H2000
'The browse dialog will display files as well as folders
iBrowseIncludesFiles = &H4000

' Root folder = Desktop
bInfo.pidlRoot = 0&

' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If

' Type of directory to return
bInfo.ulFlags = _
iFileSystemDirectoriesOnly + _
iDialogType + _
iBrowseForComputers + _
iBrowseForPrinters + _
iBrowseIncludesFiles

' Display the dialog
x = SHBrowseForFolder(bInfo)

' Parse the result
Path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal Path)
If r Then
Pos = InStr(Path, Chr$(0))
GetDirectory = Left(Path, Pos - 1)
Else
GetDirectory = ""
End If
End Function
'/===============================================/
Private Function FindSlash(strFullPath As String) As Integer
Dim ix As Integer, iy As Integer

FindSlash = 0

For ix = Len(strFullPath) To 1 Step -1
If Mid(strFullPath, ix, 1) = "\" Or _
Mid(strFullPath, ix, 1) = "/" Then
FindSlash = ix
Exit For
End If
Next ix

End Function
'/===============================================/


HTH,
--
Gary Brown

If this post was helpful, please click the ''Yes'' button next to ''Was this
Post Helpfull to you?''.


"Raj Mazumdar" wrote:

Hi there... am posting this again... perhaps got overlooked the first time.

I have an excel spreadsheet that has more than 500 different hyperlinks to
500 different emails stored in another folder. Now as soon as the number of
emails exceed 100, I create a new sub-folder and move the already-linked
emails
into the sub-folder thus losing all the linkings. Is there a way to avoid
losing
the linkings... isn't there a way to hyperlink a document so that the link
is not
lost even if the linked document is moved?

Thanks

Raj