1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
| Function OpenFicLinks(ByVal LienValide As String)
Dim TF As Boolean, LienType$
TF = True
' -------------------- Vérification Liens --------------------
If InStr(LienValide, ":\") > 0 Then
If Len(Dir(LienValide)) = 0 Then TF = False: LienType = " Fichier "
ElseIf InStr(LienValide, "://") > 0 Then
Dim oXHTTP As Object
Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
oXHTTP.Open "HEAD", LienValide, False
oXHTTP.Send
If xlErrValue Then TF = (oXHTTP.Status = 200): LienType = " Internet "
Set oXHTTP = Nothing
End If
If TF = False Then MsgBox "Lien" & LienType & "non valide. A vérifier :" & vbCrLf & vbCrLf & LienValide: Exit Function
' -------------------- Fin Vérification Liens --------------------
Dim OuvrirFicEtLiens As Object
Set OuvrirFicEtLiens = CreateObject("Shell.Application")
OuvrirFicEtLiens.Open (LienValide)
Set OuvrirFicEtLiens = Nothing
End Function |
Partager