HOME > エクセルVBA > サンプル > PathIsURL

PathIsURL


【ファイル名】PathIsURL.xlsm
【バージョン】Ver 1.0.0.0
【作成日】2021年05月20日
【動作確認】Windows 10
【必要なソフト】Microsoft Excel 2010
【ダウンロード】PathIsURL.zip
【説明】Windows APIのPathIsURLW関数でパスがURLか表示します。
画面

【外部リンク】Windows > Apps > Win32 > API > The Windows Shell > Shlwapi.h >  PathIsURLW function

customUI14.xml
<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="onLoad">
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="Tab1" label="サンプル" insertBeforeMso="TabHome" keytip="S">
        <group id="Group1" label="PathIsURL">
          <box id="Box1" boxStyle="horizontal">
            <editBox id="editBox1" label="URL:" keytip="U" maxLength="1024" getText="getText" onChange="onChange"
                     supertip="パスを入力して、Enter キーを押してください。"
                     sizeString="WWWWWMMMMMWWWWWMMMMMWWWWWMMMMMWWWWWMMMMMWWWWWMMMMMWWWWWMMMMMWWWWWMMMMMWWWWWMMMMM" />
            <button id="CheckButton" label="パスがURLか?" keytip="C" imageMso="HappyFace"
                    supertip="入力したパスがURLか表示します。" onAction="onAction" />
          </box>
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>
このページの上

Module1
Option Explicit

Private rbRibbonUI As IRibbonUI   ' リボン
Private rbText As String ' editBoxの文字列

#If Win64 Then
  ' https://docs.microsoft.com/ja-jp/windows/win32/api/shlwapi/nf-shlwapi-pathisurlw
  Private Declare PtrSafe Function PathIsURL Lib "shlwapi.dll" Alias "PathIsURLW" (ByVal pszPath As LongPtr) As Long
#Else
  Private Declare Function PathIsURL Lib "shlwapi.dll" Alias "PathIsURLW" (ByVal pszPath As Long) As Long
#End If

Sub onLoad(ribbon As IRibbonUI) ' リボンの初期処理
  Set rbRibbonUI = ribbon ' リボンの表示を更新できるようにするためにリボンをセットする
  rbText = "http://suyamasoft.blue.coocan.jp/index.html"
  rbRibbonUI.Invalidate ' リボンの表示を更新します。
End Sub

Sub onAction(control As IRibbonControl) ' 各メニューの処理
  On Error GoTo ErrorHandler ' エラー処理ルーチン
  
  Select Case control.ID
    Case "CheckButton"
      If Len(rbText) < 1 Then
        MsgBox Prompt:="パスを入力してください!", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
        Exit Sub
      End If
      
      If PathIsURL(StrPtr(rbText)) = 0 Then
        MsgBox Prompt:="入力パスはURLではありません。", Buttons:=vbInformation, Title:="情報"
      Else
        MsgBox Prompt:="入力パスはURLです。", Buttons:=vbInformation, Title:="情報"
      End If
    Case Else
      Beep ' 警告音
      MsgBox Prompt:=control.ID & "の処理がありません!", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
      Exit Sub
  End Select
  
  Exit Sub
'
ErrorHandler: ' エラー処理ルーチン
  Beep ' 警告音
  MsgBox Prompt:="エラー番号:" & Err.Number & vbCrLf & Err.Description, Buttons:=vbCritical + vbSystemModal, Title:="エラー"
End Sub

Sub getText(control As IRibbonControl, ByRef returnedVal) ' editBoxに文字列を代入する
  returnedVal = rbText
End Sub

Sub onChange(control As IRibbonControl, text As String) ' editBoxで[Enter]キーを押したか、他のコントロールに移動した場合のイベント
  rbText = text
End Sub
このページの上