On Monday, August 22, 2022 at 10:45:30 AM UTC-5, musicloverlch wrote:
Thank you! That put me in the right direction. I wrote a little VBA to cycle through the table and replace all the hyperlinks
Private Sub Command0_Click()
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("SELECT HyperlinkField FROM Table1;")
Do Until rst.EOF
rst.Edit
rst.Fields(0) = Replace(rst.Fields(0), "#http://localhyperlink/", "#https://onlinehyperlink/", 1)
rst.Update
rst.MoveNext
Loop
Set rst = Nothing
End Sub
So now I have a new problem. I know the hyperlinks are correct because when I manually copy and paste one into the browser, it works fine. However, when I click on the link in the database I get an error that says "Cannot download the information you
requested." This is apparently a know issue. Sigh. There's always one more hurdle.
Thanks for your help!
You can handle the hyperlink with a form event procedure.
Use a normal text control for the hyperlink column.
In control's double click try the following
application.FollowHyperlink nz(me.[ControlName]),,True,false
If you get warnings then replace with some code originally written by Dev Ashish.
Ex in event procedure
fHandleFile nz(me.[ControlName]), ApiWindowOpenStyleEnum.WIN_NORMAL
Add to new module
'************ Code Start Dev Ashish. **********
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
Private Declare Function apiShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
'***App Window Constants***
Public Enum ApiWindowOpenStyleEnum
WIN_NORMAL = 1 'Open Normal
WIN_MAX = 3 'Open Maximized
WIN_MIN = 2 'Open Minimized
End Enum
'***Error Codes***
Private Const ERROR_SUCCESS As Long = 32&
Private Const ERROR_NO_ASSOC As Long = 31&
Private Const ERROR_OUT_OF_MEM As Long = 0&
Private Const ERROR_FILE_NOT_FOUND As Long = 2&
Private Const ERROR_PATH_NOT_FOUND As Long = 3&
Private Const ERROR_BAD_FORMAT As Long = 11&
'***************Usage Examples*********************** Dev Ashish.
'Open a folder: ?fHandleFile("C:\TEMP\",ApiWindowOpenStyleEnum.WIN_NORMAL) 'Call Email app: ?fHandleFile("mailto:
[email protected]",ApiWindowOpenStyleEnum.WIN_NORMAL)
'Open URL: ?fHandleFile("
http://home.att.net/~dashish", ApiWindowOpenStyleEnum.WIN_NORMAL)
'Handle Unknown extensions (call Open With Dialog):
' ?fHandleFile("C:\TEMP\TestThis", ApiWindowOpenStyleEnum.Win_Normal)
'Start Access instance:
' ?fHandleFile("I:\mdbs\CodeNStuff.mdb", WApiWindowOpenStyleEnum.in_NORMAL)
'
' Returns -1 as a string on Sucess
' Returns Windows Error code and ", Error Text" if failed to open file or path '
' Use instead of application.followhyperlink if getting security warning '****************************************************
'
Public Function fHandleFile(stFile As String, lShowHow As ApiWindowOpenStyleEnum) As String
On Error GoTo errfHandleFile
Dim lRet As Long
Dim varTaskID As Variant
Dim stRet As String
'First try ShellExecute
lRet = apiShellExecute(hWndAccessApp, vbNullString, _
stFile, vbNullString, vbNullString, lShowHow)
If lRet > ERROR_SUCCESS Then
stRet = vbNullString
lRet = -1
Else
Select Case lRet
Case ERROR_NO_ASSOC:
' 'Try the OpenWith dialog
' varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " & stFile, WIN_NORMAL)
' lRet = (varTaskID <> 0)
' Don't try OpenWith (may not work on W10), return error 8-24-21
stRet = "Error: No File Association. Couldn't Execute!"
Case ERROR_OUT_OF_MEM:
stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
Case ERROR_FILE_NOT_FOUND:
stRet = "Error: File not found. Couldn't Execute!"
Case ERROR_PATH_NOT_FOUND:
stRet = "Error: Path not found. Couldn't Execute!"
Case ERROR_BAD_FORMAT:
stRet = "Error: Bad File Format. Couldn't Execute!"
Case Else:
' Add error text on else 8-24-21
stRet = "Error: Couldn't Execute!"
End Select
End If
fHandleFile = lRet & _
IIf(stRet = vbNullString, vbNullString, ", " & stRet)
donefHandleFile:
Exit Function
errfHandleFile:
debug.print err.Description
Resume donefHandleFile
End Function
PS:
You can use the replace function in a query, which will be quicker then a record set.
--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)