Discussion :

[Chipss]

Bonjour,

Voila grâce à une macro exel j'ouvre un fichier pdf dans un onglet Internet Explorer. Je cherche alors à sauvegarder ce fichier sur mon disque.

La seul façon de faire que j'ai trouvé est l'utilisation de SendKeys, ce qui ne fonctionne pas tout le temps.

J'aurais donc aimé savoir s'il existe une manière de recuperer ce document pdf plus simplement.

J'espere avoir été clair et j'attends une reponse de votre part

Ci dessous mon code si cela vous est utile.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
Sub IE_dl2(S As String)
'nécéssite d'activer la référence Microsoft HTML Objects Library
'nécéssite d'activer la référence Microsoft Internet Controls
 
Set IE = CreateObject("InternetExplorer.Application")
'IE.Visible = True
IE.Navigate S
 
Dim chemin() As String
Dim PPath As String
PPath = Mid(ThisWorkbook.Path, 1, Len(ThisWorkbook.Path) - 6)
 
Dim x As Integer
Dim maPageHtml
 
Do
    DoEvents
Loop Until IE.ReadyState = 4
 
Set maPageHtml = IE.document
 
j = 0
IE.Visible = True
For x = 0 To maPageHtml.Links.Length - 1
    ext = Right(maPageHtml.Links(x), 3)
    If ext = "pdf" Then
        j = j + 1
        maPageHtml.Links(x).Click
        Sleep 1000
        SendKeys "+^{S}", 1
        Sleep 500
        SendKeys "^{X}"
        Sleep 500
        SendKeys PPath, 1
        Sleep 500
        SendKeys "{\}"
        Sleep 500
        SendKeys "^{V}"
        Sleep 500
        SendKeys "{ENTER}"
    ElseIf ext = "doc" Then
        i = i + 1
        maPageHtml.Links(x).Click
        Sleep 5000
 
        Do
            On Error Resume Next
            Set appwd = GetObject(, "Word.application")
            If Err.Number = 429 Then
                erreur = True
            ElseIf Err.Number = 0 Then
                erreur = False
            End If
        Loop While erreur = True
 
        docName = appwd.ActiveDocument.Name
        appwd.ActiveDocument.SaveAs Filename:=PPath & "\" & docName
        ReDim Preserve chemin(i - 1)
        chemin(i - 1) = PPath & "\" & docName
        appwd.ActiveDocument.Close
        appwd.Quit
    ElseIf ext = "xls" Then
        maPageHtml.Links(x).Click
    End If
Next
 
'IE.Visible = False
 
If i <> 0 Then
    For k = 0 To i - 1
        Set appwd = CreateObject("Word.Application")
        appwd.Visible = True
        appwd.Documents.Open (chemin(k))
    Next k
End If
 
 
If (i + j) <> 0 Then
    MsgBox ("Download managed! " & Chr(10) & i + j & " Files downloaded")
Else
    MsgBox ("No Files attached to this DP! Try another one or attach the files yourself")
End If
 
'IE.Quit
 
End Sub

Chipss

[JeanSairien]

Bonjour,

Essais de passer par un lien hypertexte, ou un liens internet. Tu devrais pouvoir récupérer le chemin d'accès du liens hypertexte, et ainsi avec saveas pouvoir le sauvegarder autre part.

[Chipss]

Re,

Tout d'abord merci JeanSairien pour ta reponse

Malheureusement je n'ai pas trop compris ce que tu voulais dire. J'ai deja le lien pour acceder au fichier, il est contenue dans 'maPageHtml.Links(x)'. Cependant je ne pense pas qu'à partir d'un save as je puisse sauvegarder un fichier pdf car ce format n'est pas géré par Excel 2003 .

Apres je n'ai peut etre pas compris ce que tu voulais dire...


Chipss

[JeanSairien]

J'ai réussi à faire une copie de document en pdf d'un répertoire à un autre.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
TestPath = maPageHtml.Links(x).Item(1).Address
TestPath2 = Mid(TestPath, InStrRev(TestPath, "\") + 6) 'permet de récupérer le nom du fichier uniquement (change le'6' si cela ne fonctionne pas
MsgBox TestPath2 'afin de voir si tu as tout récupérer essai sans le ', +6' pour voir si tu as le .pdf dans ce cas là, la ligne suivante ne sers à rien
TestPath2 = TestPath2 & ".pdf"
 
FileCopy 'chemin d'accès', TestPath2

Moi j'ai réussi à faire une copie de ce fichier. Mais je l'ai pris sur un disque dur et pas à partir d'un lien internet, mais essai.

[Chipss]

Hmm deja je ne comprend pas pourquoi les arguments de FileCopy sont en commentaire enfin je me suis dis que je devais changer 'chemin d'acces' par le lien du fichier pdf

J'ai donc ecris 2 3 ligne pour voir si j'avais compris ce que tu me disiais de faire. Voire ci-dessous:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub mm()
 
 
TestPath = "https://shared-workspaces.corp.intraxa/GroupSolutions/Support/Propale/Lists/DP%202010/Attachments/85/2010_DP_EVOL.pdf"
TestPath2 = ThisWorkbook.Path & "doc.pdf"
 
FileCopy TestPath, TestPath2
 
End Sub

Malheureusement ceci ne marche pas et me renvoie l'erreur 52 Nom ou numero de fichier incorect.

J'ai alors essayé avec un fichier pdf contenue directement sur mon disque et ta methode marche.

Je pense donc que le probleme vient du faite que TestPath est un lien internet :/ si tu vois un moyen de regler ce point je suis preneur :p

Chipss

[JeanSairien]

Apparemment FileCopy fonctionnerais à partir d'un répertoire source sur un disque dur. Par contre je suis désolé mais je n'ai jamais travaillé à partir de liens internet et je ne sais pas comment récupérer le fichier. Mais cela doit exister.

[Chipss]

Bon la reponse était (comme svt :p) dans la FAQ

Je met le bout de code pour ce que ca interesse...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 
Option Explicit
 
Private Declare Function URLDownloadToFile _
    Lib "urlmon" Alias "URLDownloadToFileA" _
    (ByVal pCaller As Long, ByVal szURL As String, _
    ByVal szFileName As String, ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As Long
 
Private Const ERROR_SUCCESS As Long = 0
 
 
Sub LancementProcedure()
    DownloadFile _
        "https://shared-workspaces.corp.intraxa/GroupSolutions/Support/Propale/Lists/DP%202010/Attachments/85/2010_DP_EVOL.pdf", "C:\LOCAL\DPA5.0\source\rapport.pdf"
End Sub
 
 
Public Function DownloadFile(ByVal sURL As String, _
    ByVal sLocalFile As String) As Boolean
 
    Dim lngRetVal As Long
    DownloadFile = URLDownloadToFile(0&, sURL, _
        sLocalFile, 0&, 0&) = ERROR_SUCCESS
End Function