Aide pour traitement d'une chaine de caractères (URL)

[doublenico]

Bonjour,

Je dois faire en fonction un traitement A ou B sur une url mais je ne sais pas comment faire.
Mon url se présente sous la forme suivante :

Traitement A :
url ==> h*ttp://preprod.inet.com/doc/1/9/5/0/9/1/6/5/3/source.xls
Je souhaiterai que cette url se transforme en :
h*ttp://preprod.inet.com/doc/1/9/5/0/9/1/6/5/3/

Il faudrait donc je pense attaquer l url par le dernier caractère (ici le S de xls) et effacer tous les caractères jusqu'au premier "/" rencontré

Traitement B :
url ==> h*ttp://preprod.inet.com/doc/1/9/5/0/9/1/6/5/3/source.xls
Je souhaiterai que cette url se transforme en :
h*ttp://preprod.inet.com/webpub/modifyDocument.do?OID=195091653
Il faudrait donc à partir du ".com/" ajouter "webpub/modifyDocument.do?OID=" + récupérer seulement les chiffre de la chaine de caracteres "1/9/5/0/9/1/6/5/3/s"

Je suis vraiment perdu.

Merci d'avance

 

[pierrejean]

Re : Aide pour traitement d'une chaine de caractères (URL)

bonjour doublenico

vois si cela te convient

 

[doublenico]

Re : Aide pour traitement d'une chaine de caractères (URL)

Merci beaucoup, le résultat est bien ce que je veux parcontre je souhaite intégré ce que tu as fait dans ma amcro que voici mais je n'y arrive pas

Sub OpenFiche()
Dim IE As InternetExplorer
Dim strFullName As String, strName As String, strOID As String, strOID_DOM As String, strtmp As String
Dim iposOID As Integer, iposOID_DOM As Integer, ipos As Integer
Dim strSite As String
Dim strAppName As String
Dim n As Integer


On Error GoTo endall

strAppName = Application.Name
If InStr(1, strAppName, "Excel") <> 0 Then
strName = ActiveWorkbook.Name
End If
On Error GoTo 0
strFullName = ActiveWorkbook.FullName
strtmp = Replace(strFullName, strName, "")
'Vérifions que le classeur est un classeur sur PC INFO
ipos = InStrRev(strtmp, "pcinfo.inetpsa.com")
If ipos > 0 Then
strSite = Mid(strtmp, 1, ipos + 17)
On Error Resume Next
'ouverture de IE
Set IE = GetObject(, "InternetExplorer")
If Err.Number <> 0 Then
Set IE = New InternetExplorer
Err.Clear
End If
On Error GoTo erreur
'http://dcpi.pcinfo.inetpsa.com/nav/document/fiche.do?OID=124727687
'http://dsc.pcinfo.inetpsa.com/doc/126103104.pc1fd
'-----------------------maj pcinfo--------------------
' N 17/10/06 Prend en compte les url du type pc1fx
'http://dsc.pcinfo.inetpsa.com/doc/126103104.pc1fd
'http://dsc.pcinfo.inetpsa.com/doc/126103104.pc1fm
'http://dsc.pcinfo.inetpsa.com/nav/document/fiche.do?OID=126103104.pc1fm
'http://dsc.pcinfo.inetpsa.com/nav/document/fiche.do?OID=126103104

If InStr(strFullName, "pc1fm") > 0 Then
'strFullName = Replace(strFullName, "/doc/", "/nav/document/fiche.do?OID=")
strFullName = Replace(strFullName, ".pc1fm", ".pc1fd")
IE.Navigate (strFullName)
While IE.Busy
Sleep 300
Wend
IE.Visible = True
Set IE = Nothing
Exit Sub
ElseIf InStr(strFullName, "viewFile.do") > 0 Then
strFullName = Replace(strFullName, "viewFile", "fiche")
IE.Navigate (strFullName)
While IE.Busy
Sleep 300
Wend
IE.Visible = True
Set IE = Nothing
Exit Sub
' Intergration dt ton code ici


Else
'-----------------------maj pcinfo--------------------

IE.Navigate (strtmp)
While IE.Busy
' 'Attendre
Sleep 500
Wend
IE.Visible = True
strtmp = IE.LocationURL
If InStr(1, strtmp, "OID_DOM=") < 1 Then
Sleep 1000
strtmp = IE.LocationURL
End If
If InStr(1, strtmp, "OID_DOM=") < 1 Then
IE.Quit
MsgBox "Vous n'êtes pas sous PCINFO DIFA."
GoTo erreur
End If
On Error GoTo 0
'définition des regles pour chemin d'acces
iposOID = InStr(1, strtmp, "OID=")
iposOID_DOM = InStr(1, strtmp, "&OID_DOM=")
strOID = Mid(strtmp, iposOID + 4, (Len(strtmp) - iposOID_DOM) - 8)
strOID_DOM = Mid(strtmp, iposOID_DOM + 9, Len(strtmp))
'accede à la fiche descritive
IE.Navigate (strSite & "/jsp/nav/document/pc1_index.jsp?OID=" & strOID & "&OID_DOM=" & _
strOID_DOM)
While IE.Busy
' 'Attendre
Sleep 300
Wend
IE.Visible = True
Set IE = Nothing
Exit Sub
End If
Else

MsgBox "Le classeur n'est pas sur PC Info. Vous ne pouvez pas consulter la fiche. " & Chr(10) & Chr(10) & " " & Chr(10) & " Contact : Nicolas ", , "Macro fiche Excel"
Exit Sub
End If
erreur:
Application.Workbooks.Open strFullName
endall:
End Sub

 

[pierrejean]

Re : Aide pour traitement d'une chaine de caractères (URL)

re

pas le temps (ni beaucoup l'envie) de decortiquer ta macro !!

transformées en fonction mes macros seront peut-etre plus faciles a utiliser

du genre

dim monurl as string
 
monurl=A(".......")
 
ou monurl=B(".....")

les fonctions:

Function A(url As String)
  For n = Len(url) To 1 Step -1
  If Mid(url, n, 1) = "/" Then
    x = n
    Exit For
  End If
  Next n
A = Left(url, x)
End Function
 

Function B(url As String)
ajout = "webpub/modifyDocument.do?OID="
For n = 1 To Len(url) - 1
 If Mid(url, n, 1) = "/" And IsNumeric(Mid(url, n + 1, 1)) Then
   num = num & Mid(url, n + 1, 1)
 End If
Next n
x = InStr(url, ".com/") + 5
B = Left(url, x) & ajout & num
End Function

 

[doublenico]

Re : Aide pour traitement d'une chaine de caractères (URL)

merci beaucoup, je vais tester tout ca