Function FunctionURL(URL)
Dim Char As Variant
Dim Var As Integer
For i = 1 To Len(URL)
Char = Mid(URL, i, 1)
If Char = "/" Then
Var = Var + 1
End If
If Var = 3 Then
FunctionURL = Left(URL, i - 1)
If FunctionURL = "" Then
FunctionURL = URL
Exit Function
End If
Exit Function
End If
Next i
FunctionURL = FunctionURL
End Function
mais certains sites sont de cette forme
http://forum.site.com/xxxx/xxxx/
ma macro la rend comme ça
http://forum.site.com
je voudrai la modifier pour qu'elle ne garde que ce qu'il y aprés le premier point
Function FunctionURL(URL)
Dim Char As Variant
Dim Var As Integer
For i = 1 To Len(URL)
Char = Mid(URL, i, 1)
If Char = "/" Then
Var = Var + 1
End If
If Var = 3 Then
FunctionURL = Left(URL, i - 1)
If FunctionURL = "" Then
FunctionURL = URL
Exit Function
End If
Exit Function
End If
Next i
FunctionURL = Mid(FunctionURL, InStr(FunctionURL, ".") + 1)
End Function
NB: j'ai agrémenté ton code avec des tabulations pour mieux comprendre sa structure (une bonne habitude à prendre AMHA).
salut david, ton code fonctionne a 80%, le seul probléme qui reste c'est que certains sites sans point aprés les slash, exemple https://wikipedia.org/ deviennent org et non wikipedia.org
tu me fournis généreusement 3 adresses...espérons pour toi que cela soit suffisant pour exposer ta demande de manière exhaustive.
A tester (fonction utilisant une expression rationnelle) :
Code:
Function ExtraireURL(URL) As String
Dim oRegExp As Object, oMatches As Object
Set oRegExp = CreateObject("vbscript.regexp")
With oRegExp
.Pattern = "^http(?:s)*://(?:www.)*(\w+[\.-]{1}\w+\.(?:com|net)).*$"
If .test(URL) = True Then
Set oMatches = .Execute(URL)
ExtraireURL = oMatches.Item(0).submatches.Item(0)
End If
End With
End Function
Function ExtraireURL(URL) As String
Dim oRegExp As Object, oMatches As Object
Set oRegExp = CreateObject("vbscript.regexp")
With oRegExp
.Pattern = "//(?:www.)*([^/]+)/"
If .test(URL) = True Then
Set oMatches = .Execute(URL)
ExtraireURL = oMatches.Item(0).submatches.Item(0)
End If
End With
End Function