software

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

RajGive 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 quot;shell32.dllquot; _
Alias quot;SHGetPathFromIDListAquot; (ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib quot;shell32.dllquot; _
Alias quot;SHBrowseForFolderAquot; (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( _
quot;If you have NOT Backed up this workbook prior to this processingquot; _
amp; vbCr amp; quot; select CANCEL and perform backup, otherwisequot; amp; _
vbCr amp; quot; select OK to continue.quot;, _
vbExclamation vbOKCancel vbDefaultButton1, quot;Warning Prior to
Processing... www.kinneson.comquot;)

If varAnswer lt;gt; vbOK Then
MsgBox quot;The user has canceled this process...quot; amp; vbCr amp; _
quot;Process halted.quot;, vbCritical vbOKOnly, quot;Warning...quot;
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:= _
quot;Select Range of Hyperlink cells to be changedquot;, _
Title:=quot;Select Range of hyperlinks.... www.kinneson.comquot;, _
Default:=strOriginalAddress, Type:=8)

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

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

'give choices of how to enter new hyperlink path
varAnswer = _
MsgBox(quot;Yes - 'Browse/Point-and-Click' at a Drive/Folderquot; amp; _
vbCr amp; quot;No - 'Type in' new Hyperlink pathquot; amp; _
vbCr amp; quot;Cancel - Halt this processquot;, _
vbInformation vbYesNoCancel vbDefaultButton1, _
quot;Select an Action [Yes/No/Cancel]... www.kinneson.comquot;)

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

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

Case vbCancel
MsgBox quot;The user has canceled this process...quot; amp; vbCr amp; _
quot;Process halted.quot;, vbCritical vbOKOnly, quot;Warning...quot;
GoTo exit_Sub

Case Else
MsgBox quot;Unexpected Error...quot; amp; vbCr amp; _
quot;Process halted.quot;, vbCritical vbOKOnly, quot;Warning...quot;
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 = quot;quot;
Else
If Right(Trim(h.Address), 1) = quot;/quot; Then
strAddress = strInputBox
Else
If FindSlash(h.Address) lt;gt; 0 Then
strAddress = strInputBox amp; _
Right(h.Address, Len(h.Address) - FindSlash(h.Address))
End If
End If
End If

'get sub-address
strSubAddress = h.SubAddress

'get name amp; parent amp; text-to-display
If Len(strAddress) lt;gt; 0 Then
If Len(strSubAddress) lt;gt; 0 Then
strName = strAddress amp; quot; - quot; amp; strSubAddress
strParent = strName
strTextToDisplay = strName
Else
strName = strAddress
strParent = strAddress
strTextToDisplay = strAddress
End If
Else
If Len(strSubAddress) lt;gt; 0 Then
strName = strSubAddress
strParent = _
Right(h.SubAddress, _
Len(h.SubAddress) - InStr(1, h.SubAddress, quot;!quot;))
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 = amp;H1
'Dialog style with context menu and resizability
iDialogType = amp;H40
'Only returns computers
iBrowseForComputers = amp;H1000
'Only return printers
iBrowseForPrinters = amp;H2000
'The browse dialog will display files as well as folders
iBrowseIncludesFiles = amp;H4000

' Root folder = Desktop
bInfo.pidlRoot = 0amp;

' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = quot;Select a folder.quot;
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 = quot;quot;
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) = quot;\quot; Or _
Mid(strFullPath, ix, 1) = quot;/quot; 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?''.quot;Raj Mazumdarquot; wrote:

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

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

quot;Gary L Brownquot; wrote:

gt; Give this a shot. It will change the path of all hyperlinks in the selected
gt; range to a single new path.
gt; Test using a back up first.
gt;
gt; '/===============================================/
gt; '32-bit API declarations
gt; Private Declare Function SHGetPathFromIDList Lib quot;shell32.dllquot; _
gt; Alias quot;SHGetPathFromIDListAquot; (ByVal pidl As Long, _
gt; ByVal pszPath As String) As Long
gt;
gt; Private Declare Function SHBrowseForFolder Lib quot;shell32.dllquot; _
gt; Alias quot;SHBrowseForFolderAquot; (lpBrowseInfo As BROWSEINFO) _
gt; As Long
gt;
gt; '/===============================================/
gt; Public Type BROWSEINFO
gt; hOwner As Long
gt; pidlRoot As Long
gt; pszDisplayName As String
gt; lpszTitle As String
gt; ulFlags As Long
gt; lpfn As Long
gt; lParam As Long
gt; iImage As Long
gt; End Type
gt; '/===============================================/
gt;
gt; Sub HyperlinkChangeLinkPath()
gt; ' Change path of all hyperlinks in range to a single new path
gt; ' If there is no 'address', then the path does not get changed
gt; '
gt; ' Gary L. Brown
gt; ' Kinneson Consulting
gt; ' www.kinneson.com
gt; ' 12/18/2001
gt; '
gt; Dim h As Hyperlink
gt; Dim i As Integer, iCount As Integer
gt; Dim x As Integer, y As Integer
gt; Dim rngInput As Range
gt; Dim strInputBox As String, strMsg As String
gt; Dim strAnchor As String, strOriginalAddress As String
gt; Dim strSubAddress As String, strAddress As String
gt; Dim strName As String, strParent As String
gt; Dim strTextToDisplay As String
gt; Dim varAnswer As Variant
gt;
gt; On Error Resume Next
gt;
gt; 'test if back up was performed prior to running this macro
gt; varAnswer = _
gt; MsgBox( _
gt; quot;If you have NOT Backed up this workbook prior to this processingquot; _
gt; amp; vbCr amp; quot; select CANCEL and perform backup, otherwisequot; amp; _
gt; vbCr amp; quot; select OK to continue.quot;, _
gt; vbExclamation vbOKCancel vbDefaultButton1, quot;Warning Prior to
gt; Processing... www.kinneson.comquot;)
gt;
gt; If varAnswer lt;gt; vbOK Then
gt; MsgBox quot;The user has canceled this process...quot; amp; vbCr amp; _
gt; quot;Process halted.quot;, vbCritical vbOKOnly, quot;Warning...quot;
gt; GoTo exit_Sub
gt; End If
gt;
gt; 'store current selection in a variable
gt; strOriginalAddress = Selection.Address
gt;
gt; 'get range containing hyperlinks to be changed
gt; Set rngInput = _
gt; Application.InputBox(Prompt:= _
gt; quot;Select Range of Hyperlink cells to be changedquot;, _
gt; Title:=quot;Select Range of hyperlinks.... www.kinneson.comquot;, _
gt; Default:=strOriginalAddress, Type:=8)
gt;
gt; ' Count the # of hyperlinks in the selected range
gt; i = rngInput.Hyperlinks.Count
gt;
gt; If i = 0 Then
gt; MsgBox quot;No cells with hyperlinks have been selected.quot;, _
gt; vbExclamation vbOKOnly, _
gt; quot;Warning... Processed halted... www.kinneson.comquot;
gt; GoTo exit_Sub
gt; End If
gt;
gt; 'give choices of how to enter new hyperlink path
gt; varAnswer = _
gt; MsgBox(quot;Yes - 'Browse/Point-and-Click' at a Drive/Folderquot; amp; _
gt; vbCr amp; quot;No - 'Type in' new Hyperlink pathquot; amp; _
gt; vbCr amp; quot;Cancel - Halt this processquot;, _
gt; vbInformation vbYesNoCancel vbDefaultButton1, _
gt; quot;Select an Action [Yes/No/Cancel]... www.kinneson.comquot;)
gt;
gt; Select Case varAnswer
gt; Case vbYes
gt; strMsg = _
gt; quot; Select location of Hyperlink path or press Cancel.quot;
gt; strInputBox = GetDirectory(strMsg)
gt; If strInputBox = quot;quot; Then
gt; MsgBox quot;A folder has not been selected...quot; amp; vbCr amp; _
gt; quot;Process halted.quot;, vbCritical vbOKOnly, quot;Warning...quot;
gt; GoTo exit_Sub
gt; End If
gt; If Right(strInputBox, 1) lt;gt; quot;\quot; Then strInputBox = strInputBox amp; quot;\quot;
gt;
gt; Case vbNo
gt; strInputBox = _
gt; InputBox(quot; Enter location of Hyperlink path or press Cancel.quot; amp; _
gt; vbCrLf amp; vbCrLf amp; quot;NOTES:quot; amp; vbCrLf amp; _
gt; quot; If you are entering a URL, you MUST endquot; amp; _
gt; vbCrLf amp; quot; the entry with a back-slash (/) or the hyperlinkquot; amp; _
gt; vbCrLf amp; quot; will not work correctly...quot; amp; vbCrLf amp; vbCrLf amp; _
gt; quot; If you are entering a file path, you MUST endquot; amp; _
gt; vbCrLf amp; quot; the entry with a forward-slash (\) or the hyperlinkquot; amp; _
gt; vbCrLf amp; quot; will not work correctly...quot;, _
gt; quot;Enter a valid path... www.kinneson.comquot;)
gt; If strInputBox = quot;quot; Then
gt; MsgBox quot;A folder has not been entered...quot; amp; vbCr amp; _
gt; quot;Process halted.quot;, vbCritical vbOKOnly, quot;Warning...quot;
gt; GoTo exit_Sub
gt; End If
gt;
gt; Case vbCancel
gt; MsgBox quot;The user has canceled this process...quot; amp; vbCr amp; _
gt; quot;Process halted.quot;, vbCritical vbOKOnly, quot;Warning...quot;
gt; GoTo exit_Sub
gt;
gt; Case Else
gt; MsgBox quot;Unexpected Error...quot; amp; vbCr amp; _
gt; quot;Process halted.quot;, vbCritical vbOKOnly, quot;Warning...quot;
gt; GoTo exit_Sub
gt; End Select
gt;
gt; ' go through each hyperlink in the range and change path
gt; For Each h In rngInput.Hyperlinks
gt; ' put the hyperlink's info into variables
gt; ' get range
gt; strAnchor = h.Range.Address
gt;
gt; 'get address
gt; strAddress = h.Address
gt; If Len(h.Address) = 0 Then
gt; strAddress = quot;quot;
gt; Else
gt; If Right(Trim(h.Address), 1) = quot;/quot; Then
gt; strAddress = strInputBox
gt; Else
gt; If FindSlash(h.Address) lt;gt; 0 Then
gt; strAddress = strInputBox amp; _
gt; Right(h.Address, Len(h.Address) - FindSlash(h.Address))
gt; End If
gt; End If
gt; End If
gt;
gt; 'get sub-address
gt; strSubAddress = h.SubAddress
gt;
gt; 'get name amp; parent amp; text-to-display
gt; If Len(strAddress) lt;gt; 0 Then
gt; If Len(strSubAddress) lt;gt; 0 Then
gt; strName = strAddress amp; quot; - quot; amp; strSubAddress
gt; strParent = strName
gt; strTextToDisplay = strName
gt; Else
gt; strName = strAddress
gt; strParent = strAddress
gt; strTextToDisplay = strAddress
gt; End If
gt; Else
gt; If Len(strSubAddress) lt;gt; 0 Then
gt; strName = strSubAddress
gt; strParent = _
gt; Right(h.SubAddress, _
gt; Len(h.SubAddress) - InStr(1, h.SubAddress, quot;!quot;))
gt; strTextToDisplay = strParent
gt; Else
gt; strName = h.name
gt; strParent = h.Parent
gt; strTextToDisplay = h.TextToDisplay
gt; End If
gt; End If
gt;
gt; ' change the hyperlink's info
gt; With h
gt; .Range = strAnchor
gt; .Address = strAddress
gt; .SubAddress = strSubAddress
gt; .Parent = strParent
gt; .TextToDisplay = strTextToDisplay
gt; End With
gt; Next h
gt;
gt; exit_Sub:
gt; Set rngInput = Nothing
gt;
gt; End Sub
gt; '/===============================================/
gt;
gt; Private Function GetDirectory(Optional Msg) As String
gt; Dim bInfo As BROWSEINFO
gt; Dim iFileSystemDirectoriesOnly As Long
gt; Dim iDialogType As Long
gt; Dim iBrowseForComputers As Long
gt; Dim iBrowseForPrinters As Long
gt; Dim iBrowseIncludesFiles As Long
gt; Dim Path As String
gt; Dim r As Long, x As Long, Pos As Integer
gt;
gt; iFileSystemDirectoriesOnly = 0
gt; iDialogType = 0
gt; iBrowseForComputers = 0
gt; iBrowseForPrinters = 0
gt; iBrowseIncludesFiles = 0
gt; '- - - - - - - - - - - - - - - - -
gt; 'Only return file system directories.
gt; iFileSystemDirectoriesOnly = amp;H1
gt; 'Dialog style with context menu and resizability
gt; iDialogType = amp;H40
gt; 'Only returns computers
gt; iBrowseForComputers = amp;H1000
gt; 'Only return printers
gt; iBrowseForPrinters = amp;H2000
gt; 'The browse dialog will display files as well as folders
gt; iBrowseIncludesFiles = amp;H4000
gt;
gt; ' Root folder = Desktop
gt; bInfo.pidlRoot = 0amp;
gt;
gt; ' Title in the dialog
gt; If IsMissing(Msg) Then
gt; bInfo.lpszTitle = quot;Select a folder.quot;
gt; Else
gt; bInfo.lpszTitle = Msg
gt; End If
gt;
gt; ' Type of directory to return
gt; bInfo.ulFlags = _
gt; iFileSystemDirectoriesOnly _
gt; iDialogType _
gt; iBrowseForComputers _
gt; iBrowseForPrinters _
gt; iBrowseIncludesFiles
gt;
gt; ' Display the dialog
gt; x = SHBrowseForFolder(bInfo)
gt;
gt; ' Parse the result
gt; Path = Space$(512)
gt; r = SHGetPathFromIDList(ByVal x, ByVal Path)
gt; If r Then
gt; Pos = InStr(Path, Chr$(0))
gt; GetDirectory = Left(Path, Pos - 1)
gt; Else
gt; GetDirectory = quot;quot;
gt; End If
gt; End Function
gt; '/===============================================/
gt; Private Function FindSlash(strFullPath As String) As Integer
gt; Dim ix As Integer, iy As Integer
gt;
gt; FindSlash = 0
gt;
gt; For ix = Len(strFullPath) To 1 Step -1
gt; If Mid(strFullPath, ix, 1) = quot;\quot; Or _
gt; Mid(strFullPath, ix, 1) = quot;/quot; Then
gt; FindSlash = ix
gt; Exit For
gt; End If
gt; Next ix
gt;
gt; End Function
gt; '/===============================================/
gt;
gt;
gt; HTH,
gt; --
gt; Gary Brown
gt;
gt; If this post was helpful, please click the ''Yes'' button next to ''Was this
gt; Post Helpfull to you?''.
gt;
gt;
gt; quot;Raj Mazumdarquot; wrote:
gt;
gt; gt; Hi there... am posting this again... perhaps got overlooked the first time.
gt; gt;
gt; gt; I have an excel spreadsheet that has more than 500 different hyperlinks to
gt; gt; 500 different emails stored in another folder. Now as soon as the number of
gt; gt; emails exceed 100, I create a new sub-folder and move the already-linked
gt; gt; emails
gt; gt; into the sub-folder thus losing all the linkings. Is there a way to avoid
gt; gt; losing
gt; gt; the linkings... isn't there a way to hyperlink a document so that the link
gt; gt; is not
gt; gt; lost even if the linked document is moved?
gt; gt;
gt; gt; Thanks
gt; gt;
gt; gt; Raj
gt; gt;