bleu34 | Allez je m'auto-réponds pour en faire profiter tout le monde. Je vous livre ma macro tel quel. Ca servira surement à quelqu'un.
Je vous rappele mon environnement : windows 2000, Excel 2000, le tout en anglais.
et mon problème : récupérer un fichier sur intranet via une macro Excel, cliquer sur tout les boutons pour réussir à le sauvegarder.
Code :
- Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
- (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
- Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
- (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
- Private Declare Function SetActiveWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
- Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
- (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
- Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
- (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
- Public hwnd As Long
- Private Const WM_KEYDOWN = &H100
- Private Const WM_CHAR = &H102
- Private Const VK_RETURN = &HD
- Private Const BM_CLICK = &HF5
- Sub LaunchDownload()
- On Error Resume Next
- Set ie = CreateObject("InternetExplorer.Application" )
-
- acceuil = "http://intranet"
- baseline = "http://intranet/monfichier.csv"
-
- fichier_baseline = "c:\baseline.csv"
-
- If Dir(fichier_baseline) <> "" Then Kill fichier_baseline
-
- 'connection à la page d'acceuil intranet pour éviter les problèmes de login/password
- ie.Navigate acceuil
- 'ie.Visible = True
- Do Until ie.ReadyState = 4 'Loop unitl ie page is fully loaded
- DoEvents
- Loop
-
- If ie.document.Title = "Mettre le Header de votre page, c'est juste pour un test" Then
-
- ie.Navigate baseline
- Do Until ie.ReadyState = 4
- DoEvents
- Loop
- hwnd = 0
- hwnd_fils = 0
- Do
- hwnd = FindWindow(vbNullString, "File Download" )
- If hwnd = 0 Then
- PauseTimer (1)
- Else
- hwnd_button = FindWindowEx(hwnd, 0, "Button", "&Save" )
- End If
- Loop While hwnd_button = 0
- hwnd_button_hexa = Hex(hwnd_button)
- hwnd_hexa = Hex(hwnd)
-
- SetActiveWindow hwnd
- SendMessage hwnd_button, BM_CLICK, ByVal CLng(0), ByVal CLng(0)
-
- Do
- hwnd_fils = FindWindow(vbNullString, "Save As" )
- If hwnd_fils = 0 Then
- PauseTimer (1)
- Else
- hwnd_button = FindWindowEx(hwnd_fils, 0, "Button", "&Save" )
- hwnd_level1 = FindWindowEx(hwnd_fils, 0, "ComboBoxEx32", "" )
- hwnd_level2 = FindWindowEx(hwnd_level1, 0, "ComboBox", "" )
- hwnd_level3 = FindWindowEx(hwnd_level2, 0, "Edit", "" )
- End If
- Loop While hwnd_button = 0
- hwnd_fils_hexa = Hex(hwnd_fils)
- hwnd_text_hexa = Hex(hwnd_text)
- hwnd_level3_hexa = Hex(hwnd_level3)
-
- For num = 1 To Len(fichier_baseline)
- PostMessage hwnd_level3, WM_CHAR, Asc(Mid(fichier_baseline, num, 1)), 0
- Next
- PostMessage hwnd_fils, WM_KEYDOWN, VK_RETURN, 0 'enter
- Do
- If Dir(fichier) = "" Then
- PauseTimer (1)
- End If
- Loop While Dir(fichier) = ""
- Else
- MsgBox "Please ensure that you have Internet Explorer opened" & Chr(13) & _
- "and that you are already connected to Intranet." & Chr(13) & _
- "Note : having multiple IE windows could lead to problems"
- End If
-
- ie.Quit
- Set ie = Nothing
- End Sub
- 'celle du dessous je l'ai trouvé sur le net... je ne sais plus où, en tout cas merci à celui qui l'a écrite
- Sub PauseTimer(ByVal nSecond As Single)
- Dim t0 As Single
- 'temps de référence
- t0 = Timer
- 'boucle d'attente
- Do While Timer - t0 < nSecond
- Dim dummy As Integer
- dummy = DoEvents()
- 'si on dépasse minuit,il faut
- 'retrancher un jour
- If Timer < t0 Then
- t0 = t0 - 24 * 60 * 60
- End If
- Loop
- End Sub
|
Message édité par bleu34 le 22-08-2008 à 09:40:46
|
