Quantcast
Channel: VBForums - Code It Better
Viewing all articles
Browse latest Browse all 16

Controlling External Webbrowser & Excel 2007 VBA

$
0
0
So below is my code for controlling Firefox, and pulling data from Google Adwords. I'm curious if there is any better way to code any of this.

I am very new at programming inside of Excel 2007 & VB 6.5, I used to do a little bit of programming, but nothing huge. So excuse my very sloppy work.

The major areas of improvement I'm looking for would be where maybe I could define the screen a percentage, and give those rather than the actual pixels of the monitor, that way it could be used possibly by some one else. (We're running dual monitors, if that matters)

Also a way to detect a captcha image would be good as well. Not bypass, just detect and pause for user input.

Also: Is there a way to detect in an external browser, when that current page is done loading? Instead of just issuing a wait for 20,000 milliseconds, it would be nice to know when AdWords was done, since it takes between 1-15 seconds to load sometimes.

The rest I'm just interested in ways on how to improve it, make it faster, etc etc...

Code:


Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dX As Long, ByVal dY As Long, ByVal dwData As Long, ByVal dwExtraInfo As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Const MOUSEEVENTF_ABSOLUTE = &H8000& ' absolute move
Private Const MOUSEEVENTF_LEFTDOWN = &H2    ' left button down
Private Const MOUSEEVENTF_LEFTUP = &H4      ' left button up
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20  ' middle button down
Private Const MOUSEEVENTF_MIDDLEUP = &H40    ' middle button up
Private Const MOUSEEVENTF_MOVE = &H1        ' mouse move
Private Const MOUSEEVENTF_RIGHTDOWN = &H8    ' right button down
Private Const MOUSEEVENTF_RIGHTUP = &H10    ' right button up
Private Const MOUSEEVENTF_WHEEL = &H800      ' wheel button rolled

Private Const VK_CONTROL = &H11
Private Const VK_DELETE = &H2E
Private Const VK_ALT = &H12
Private Const VK_NUMLOCK = &H90
Private Const VK_LSHIFT = &HA0
Private Const VK_RSHIFT = &HA1

Public dTime As Date

Private Type RECT
Left As Long
top As Long
Right As Long
Bottom As Long
End Type

Sub Testing()
'
' Testing Macro
'
' Keyboard Shortcut: Ctrl+Shift+W
'

'Macro co-designed by Aaron Howe and Stephen Blum.
'AutoGoogleProject v1.1.3

  Dim Delay As Long
  Dim Delay2 As Long
  Dim Delay3 As Long
  Dim Delay4 As Long
  Dim Pause As Single
  Dim Target As Range
  Dim Rec As RECT
    Delay = 1500
    Delay2 = 1000
    Delay3 = 4500
    Delay4 = 500
    Delay5 = 20000

top:
    Sheets.Add.Name = "Results"
    Sheets.Add.Name = "PreFM"
    Sheets(Sheets.Count).Select
    Range("C1").Select
   
    'Loop the entire Search Results
search:
    Do Until ActiveCell.Text = ""
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        AppActivate "Mozilla Firefox"
       
        GetWindowRect GetWindowHandle, Rec
        SetCursorPos Rec.Right + 400, Rec.top + 315
       
        mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
        Sleep 10
        mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
 
        Pause = (Delay4 / 1000) + Timer
        While Timer < Pause
            DoEvents
        Wend
   
        SendKeys ("^a")
        SendKeys ("^v")
        SendKeys "{TAB 7}", True
        SendKeys "{ENTER}", True
       
                Pause = (Delay5 / 1000) + Timer
        While Timer < Pause
            DoEvents
        Wend
       
        'Selecting all of the results starts here
selectresults:
        keybd_event VK_CONTROL, 0, 0, 0
        keybd_event VK_LSHIFT, 0, 0, 0
       
        GetWindowRect GetWindowHandle, Rec
        SetCursorPos Rec.Right + 400, Rec.top + 690
       
        mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
       
        GetWindowRect GetWindowHandle, Rec
        SetCursorPos Rec.Right + 400, Rec.top + 750
       
        Pause = (Delay4 / 1000) + Timer
        While Timer < Pause
            DoEvents
        Wend
       
        keybd_event VK_CONTROL, 0, 0, 0
        keybd_event VK_LSHIFT, 0, 0, 0
       
        GetWindowRect GetWindowHandle, Rec
        SetCursorPos Rec.Right + 1850, Rec.top + 750
       
        Pause = (Delay4 / 1000) + Timer
        While Timer < Pause
            DoEvents
        Wend
     
        keybd_event VK_CONTROL, 0, MOUSEEVENTF_LEFTDOWN, 0
        keybd_event VK_LSHIFT, 0, MOUSEEVENTF_LEFTDOWN, 0
        mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
       
        Pause = (Delay4 / 1000) + Timer
        While Timer < Pause
            DoEvents
        Wend
       
        SendKeys ("^c")
       
        Pause = (Delay4 / 1000) + Timer
        While Timer < Pause
            DoEvents
        Wend
       
        Sheets("PreFM").Select
       
        'Start the formatting of all results in PreFM
        ActiveSheet.PasteSpecial format:="Text", Link:=False, DisplayAsIcon:=False
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Selection.Delete Shift:=xlUp

        Range("A1").Select
        Rows("1:4").Select
        Selection.Delete Shift:=xlUp
        Range("A1").Select

        Range("a1").Select
        'Loop the formatting of the results
format1:
        Do Until ActiveCell.Text = ""
            'Copy and paste GMS
            ActiveCell.Offset(1, 0).Select
            ActiveCell.Copy
            ActiveCell.Offset(-1, 1).Select
            ActiveSheet.Paste
            ActiveCell.Offset(1, -1).Select
            ActiveCell.EntireRow.Delete
   
            'Copy and paste CPC
            ActiveCell.Copy
            ActiveCell.Offset(-1, 2).Select
            ActiveSheet.Paste
            ActiveCell.Offset(1, -2).Select
            ActiveCell.EntireRow.Delete
   
            'Copy and paste Competition
            ActiveCell.Copy
            ActiveCell.Offset(-1, 3).Select
            ActiveSheet.Paste
            ActiveCell.Offset(1, -3).Select
            ActiveCell.EntireRow.Delete
   
        Loop
format2:
        Columns("a:a").Select
       
        Range("a1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        Sheets("Results").Select
        Range("a1").Select
        Selection.End(xlDown).Select
        Selection.End(xlDown).Select
        Selection.End(xlUp).Select
        ActiveCell.Offset(1, 0).Select
        ActiveSheet.Paste
       
        Columns("B:B").EntireColumn.Select
        Selection.SpecialCells(xlCellTypeConstants, 2).Select
        Selection.EntireRow.Delete
        Range("A1").Select
       
        Selection.End(xlDown).Select
        Selection.End(xlDown).Select
        Selection.End(xlUp).Select
        ActiveCell.Offset(1, 0).Select
       
        Sheets("PreFM").Select
        Columns("a:d").Select
        Selection.ClearContents
        Range("a1").Select
detect:
        'Here lies the code to detect a "-"
        Sheets("Results").Select
        Columns("b:b").Select
        Selection.End(xlDown).Select
        Selection.End(xlDown).Select
        Selection.End(xlUp).Select
       
        If WorksheetFunction.IsNumber(ActiveCell) Then
            GetWindowRect GetWindowHandle, Rec
            SetCursorPos Rec.Right + 1865, Rec.top + 635
           
            mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
            Sleep 10
            mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
 
            Pause = (Delay3 / 1000) + Timer
            While Timer < Pause
                DoEvents
            Wend
            GoTo selectresults
        Else
            GoTo continue
        End If
continue:
        Sheets(Sheets.Count).Select
        Selection.End(xlDown).Select
        Selection.End(xlDown).Select
        AppActivate "Microsoft Excel"
    Loop

    Sheets("PreFM").Delete
    Sheets("Results").Select
    Columns("a:a").Select
    Selection.Replace What:="[", Replacement:=""
    Selection.Replace What:="]", Replacement:=""
   
    Pause = (Delay3 / 1000) + Timer
        While Timer < Pause
            DoEvents
        Wend
    ThisWorkbook.Save

End Sub


Viewing all articles
Browse latest Browse all 16

Trending Articles