| Private Const SW_SHOW = 5 ' Displays Window in its current size and position Private Const SW_SHOWNORMAL = 1 ' Restores Window if Minimized or Maximized Private Declare Function ShellExecute Lib "shell32.dll" _ Alias "ShellExecuteA" ( _ ByVal hwnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ Optional ByVal lpParameters As String, _ Optional ByVal lpDirectory As String, _ Optional ByVal nShowCmd As Long _ ) As Long Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" ( _ ByVal lpFile As String, _ ByVal lpDirectory As String, _ ByVal lpResult As String _ ) As Long Private Declare Function GetTempPath Lib "kernel32" _ Alias "GetTempPathA" ( _ ByVal nBufferLength As Long, _ ByVal lpBuffer As String) As Long Private Declare Function GetTempFileName Lib "kernel32" _ Alias "GetTempFileNameA" ( _ ByVal lpszPath As String, _ ByVal lpPrefixString As String, _ ByVal wUnique As Long, _ ByVal lpTempFileName As String) As Long Public Function GetTempFileNameVBA( _ Optional sPrefix As String = "VBA", _ Optional sExtensao As String = "") As String Dim sTmpPath As String * 512 Dim sTmpName As String * 576 Dim nRet As Long Dim F As String nRet = GetTempPath(512, sTmpPath) If (nRet > 0 And nRet < 512) Then nRet = GetTempFileName(sTmpPath, sPrefix, 0, sTmpName) If nRet <> 0 Then F = Left$(sTmpName, InStr(sTmpName, vbNullChar) - 1) If sExtensao > "" Then Kill F If Right(F, 4) = ".tmp" Then F = Left(F, Len(F) - 4) F = F & sExtensao End If GetTempFileNameVBA = F End If End Function Sub Test_GetTempFileNameVBA() Debug.Print GetTempFileNameVBA("BR", ".html") End Sub Private Sub LaunchBrowser() Dim FileName As String, Dummy As String Dim BrowserExec As String * 255 Dim RetVal As Long Dim FileNumber As Integer FileName = GetTempFileNameVBA("BR", ".html") FileNumber = FreeFile ' Get unused file number Open FileName For Output As #FileNumber ' Create temp HTML file Write #FileNumber, "<HTML> <\HTML>" ' Output text Close #FileNumber ' Close file ' Then find the application associated with it RetVal = FindExecutable(FileName, Dummy, BrowserExec) Kill FileName ' delete temp HTML file BrowserExec = Trim(BrowserExec) ' If an application is found, launch it! If RetVal <= 32 Or IsEmpty(BrowserExec) Then ' Error MsgBox "Could not find associated Browser", vbExclamation, "Browser Not Found" Else RetVal = ShellExecute(0, "open", BrowserExec, "http://www.yaHOO.com?case=MATTERS", Dummy, SW_SHOWNORMAL) If RetVal <= 32 Then ' Error MsgBox "Web Page not Opened", vbExclamation, "URL Failed" End If End If End Sub |
|
|
