All my sendkeys execute properly and the document saves and closes but then the next document does not Open. Before I added the sendkeys, the documents in the DIR would each open but now the next document will not. What am I doing wrong?
Sub Password()
Dim CustRow, LastRow As Long
Dim Password As String
Dim fileName As Variant
With Sheet1
LastRow = .Range("C9999").End(xlUp).Row
fileName = Dir("C:\State_K-1_Info\Password\*.pdf")
Do While fileName <> ""
CreateObject("Shell.Application").Open ("C:\State_K-1_Info\Password\" & fileName)
Application.Wait Now + 0.00005
For CustRow = 2 To LastRow
Password = .Range("C" & CustRow).Value
Application.SendKeys "{F6}", True
Application.Wait Now + 0.00001
Application.SendKeys "{Tab}", True
Application.Wait Now + 0.00001
Application.SendKeys Password, True
Application.Wait Now + 0.00002
Application.SendKeys "(~)", True
Application.Wait Now + 0.00001
Application.SendKeys Password, True
Application.Wait Now + 0.00002
Application.SendKeys "(~)", True
Application.Wait Now + 0.00001
Application.SendKeys "(~)", True
Application.Wait Now + 0.00001
Application.SendKeys "^(s)", True
Application.Wait Now + 0.00001
Application.SendKeys "%{F4}", True
Application.Wait Now + 0.00001
fileName = Dir
Next CustRow
Loop
End With
End Sub
Related
so I am trying to 'animate' a userform so that the text in a label changes over time. here is a sample of my code (it's run upon clicking a button in the userform):
Label2.Caption = "hello"
Application.Wait (Now + TimeValue("0:00:01"))
Label2.Caption = "10"
Application.Wait (Now + TimeValue("0:00:01"))
Label2.Caption = "9"
Application.Wait (Now + TimeValue("0:00:01"))
Label2.Caption = "8"
Application.Wait (Now + TimeValue("0:00:01"))
Label2.Caption = "7"
This should open with hello, then count from 10 to 7 with 1-second intervals.
When I run the code, the label changes to hello, then freezes for about 30 seconds, then, shows the last number. this problem does not happen if I step through the code with the debugger.
I've shown that Application.wait works on its own with this code (in a normal sub):
cells(1,1) = "hi"
Application.Wait (Now + TimeValue("0:00:01"))
cells(1,1) = "bye"
Application.Wait (Now + TimeValue("0:00:01"))
cells(1,1) = "hi"
how do I fix this and why is it broken?
EDIT:
This question is a duplicate. See this question
add .Repaint between changes. so my new code is:
Label2.Caption = "hello"
Application.Wait (Now + TimeValue("0:00:01"))
Label2.Caption = "10"
myForum.Repaint
Application.Wait (Now + TimeValue("0:00:01"))
Label2.Caption = "9"
myForum.Repaint
Application.Wait (Now + TimeValue("0:00:01"))
Label2.Caption = "8"
myForum.Repaint
Application.Wait (Now + TimeValue("0:00:01"))
Label2.Caption = "7"
myForum.Repaint
I am trying to get all the buttons using queryselector and select the particular button by looping through and finding innerHTML.
After finding the particular button, when click event is passed, nothing happens.
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate "https://www.spirit.com/"
Do Until IE.readyState = 4: Application.Cursor = xlDefault: DoEvents: Loop
Application.Wait (Now + TimeValue("00:00:03"))
IE.document.querySelector("label[for='radio-oneWay']").Click
Application.Wait (Now + TimeValue("00:00:03"))
IE.document.querySelector("input[id='flight-OriginStationCode']").Click
Set elems = IE.document.getElementsByTagName("button")
For Each elem In elems
If (elem.innerHTML) = " Aguadilla, Puerto Rico (BQN) " Then
elem.Click
Exit For
End If
Next elem
The two airport boxes can be assigned by simulating input using SendKeys then the click event will be triggered. The date-input and other textbox will be set separately. Here is the code which implements this function:
Private Sub CommandButton1_Click()
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate "https://www.spirit.com/"
Do Until IE.readyState = 4: Application.Cursor = xlDefault: DoEvents: Loop
Application.Wait (Now + TimeValue("00:00:03"))
IE.document.querySelector("label[for='radio-oneWay']").Click
Application.Wait (Now + TimeValue("00:00:03"))
Set elems = IE.document.getElementsByTagName("button")
Set txt1 = IE.document.getElementsByName("originStationCode")(0)
txt1.Focus
SendKeys ("BQN")
Application.Wait (Now + TimeValue("00:00:01"))
Set txt2 = IE.document.querySelector("input[id='flight-DestinationStationCode']")
txt2.Focus
SendKeys ("BDL")
Application.Wait (Now + TimeValue("00:00:01"))
Application.Wait (Now + TimeValue("00:00:01"))
IE.document.querySelector("input[id='flight-Date']").Value = "2020/10/09-2020/10/19"
IE.document.querySelector("input[id='promoCode']").Value = "xx"
IE.document.querySelector("button[type='submit']").Click
End Sub
Result:
I'm struggling to create my first macro in VBA, I try to make simple macro which will switch button in each minute to present different data.
Right now I'm really frustrated, because each time I change something I receive different error, for sure I have issues with references to worksheet which I want to choose. Currently I get error "loop without do" and when I'm deleting loop, I get compile error "expected end with".
Please find my "work" below, and please let me how to make it work.
Public Sub Switch()
Do
For Each ws In ThisWorkbook.Worksheets
ControlBoard.Activate
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("XX").Selected = True
.SlicerItems("YY").Selected = False
.SlicerItems("ZZ").Selected = False
Application.Wait Now("00:01:00")
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("XX").Selected = False
.SlicerItems("YY").Selected = True
.SlicerItems("ZZ").Selected = False
Application.Wait Now("00:01:00")
End With
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("XX").Selected = False
.SlicerItems("YY").Selected = False
.SlicerItems("ZZ").Selected = True
Application.Wait Now("00:01:00")
End With
Loop
End Sub
Ok, now I change it a bit and I get Run time error 13 (type mismatch) and I get debug on first line - Application.Wait Now("00:01:00")
Public Sub Switch()
Dim DashBoard As Sheet3
Do
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("XX").Selected = True
.SlicerItems("YY").Selected = False
.SlicerItems("ZZ").Selected = False
Application.Wait Now("00:01:00")
End With
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("XX").Selected = False
.SlicerItems("YY").Selected = True
.SlicerItems("ZZ").Selected = False
Application.Wait Now("00:01:00")
End With
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("XX").Selected = False
.SlicerItems("YY").Selected = False
.SlicerItems("ZZ").Selected = True
Application.Wait Now("00:01:00")
End With
Loop
End Sub
I have solved type mismatch by adding + TimeValue
Application.Wait Now + TimeValue("00:01:00")
But slicer doesn't behave, as I want it. It gets me at beginning ("XX") true but further on it ticking ("YY") true and ("XX") still remains, as true, can you help me to solve it?
OK I have solved this by putting True statement in first line, it's freeze from time to time but it works, can you let me know, if it's possible to add switch off key, to avoid esc+esc exit?
Public Sub Switch()
Dim DashBoard As Sheet3
Do
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("XX").Selected = True
.SlicerItems("YY").Selected = False
.SlicerItems("ZZ").Selected = False
Application.Wait Now + TimeValue("00:00:10")
End With
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("YY").Selected = True
.SlicerItems("XX").Selected = False
.SlicerItems("ZZ").Selected = False
Application.Wait Now + TimeValue("00:00:10")
End With
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("ZZ").Selected = True
.SlicerItems("XX").Selected = False
.SlicerItems("YY").Selected = False
Application.Wait Now + TimeValue("00:00:10")
End With
Loop
End Sub
I have some code that pulls data from a website, which works correctly, my issue is that you have to sign in to the website in order to get to the data I need. Everything works great until I close and reopen the sheet. If I don't do a manual pull before running the code it pulls no data from the site. Is there a way to get it to sign in for me?
Sub Search_People()
Dim Name_Of_Person As String
Dim URL As String
Dim Dashboard_Sheet As Worksheet
Set Dashboard_Sheet = ThisWorkbook.Sheets("Dashboard")
Dim Data_Sheet As Worksheet
Set Data_Sheet = ThisWorkbook.Sheets("Data")
Dim Data_Dump As Worksheet
Set Data_Dump = ThisWorkbook.Sheets("DataDump")
Dim X As Integer
Dim Y As Integer
Dim Last_Row As Long
Dim Email_Output As Range
Set Email_Output = Data_Dump.Range("A:XFD")
Dim Cell As Range
Application.EnableCancelKey = xlDisabled
Last_Row = Data_Sheet.Range("B3")
For X = 1 To Last_Row
On Error Resume Next
Name_Of_Person = Data_Sheet.Cells(2 + X, 8)
Application.StatusBar = " Pulling Data for... " & Name_Of_Person
URL = "URL;" & "https://fake.com/people/"
URL = URL & Name_Of_Person & "%40fake.com"
With Data_Dump.QueryTables.Add(Connection:= _
URL, _
Destination:=Data_Dump.Range("A1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Set Cell = Email_Output.Find("Email")
Worksheets("Data").Cells(2 + X, 9).Value = Cell
Data_Dump.Range("A:A").EntireColumn.Delete
Next X
Application.StatusBar = False
End Sub
The answer in the above link works perfectly.
Sub test()
' open IE, navigate to the desired page and loop until fully loaded
Set ie = CreateObject("InternetExplorer.Application")
my_url = ""
With ie
.Visible = True
.Navigate my_url
.Top = 50
.Left = 530
.Height = 400
.Width = 400
Do Until Not ie.Busy And ie.readyState = 4
DoEvents
Loop
End With
' Input the userid and password
ie.Document.getElementById("uid").Value = ""
ie.Document.getElementById("password").Value = ""
' Click the "Search" button
ie.Document.getElementById("enter").Click
Do Until Not ie.Busy And ie.readyState = 4
DoEvents
Loop
End Sub
Please try this...
Dim HTMLDoc As HTMLDocument
Dim oBrowser As InternetExplorer
Sub Login_2_Website()
Dim oHTML_Element As IHTMLElement
Dim sURL As String
On Error GoTo Err_Clear
sURL = "https://www.google.com/accounts/Login"
Set oBrowser = New InternetExplorer
oBrowser.Silent = True
oBrowser.timeout = 60
oBrowser.navigate sURL
oBrowser.Visible = True
Do
' Wait till the Browser is loaded
Loop Until oBrowser.readyState = READYSTATE_COMPLETE
Set HTMLDoc = oBrowser.Document
HTMLDoc.all.Email.Value = "sample#vbadud.com"
HTMLDoc.all.passwd.Value = "*****"
For Each oHTML_Element In HTMLDoc.getElementsByTagName("input")
If oHTML_Element.Type = "submit" Then oHTML_Element.Click: Exit For
Next
' oBrowser.Refresh ' Refresh If Needed
Err_Clear:
If Err <> 0 Then
Debug.Assert Err = 0
Err.Clear
Resume Next
End If
End Sub
Also, take a look at this link.
http://vbadud.blogspot.com/2009/08/how-to-login-to-website-using-vba.html
Application.SendKeys "{PGDN}", True
Works just fine, however Application.SendKeys "{%TAB}", True and Application.SendKeys "%{TAB}", True do nothing.
How do I execute an alt-tab with sendkeys to switch windows?
Here is the code:
Application.SendKeys "{PGDN}", True
Application.SendKeys "{PGDN}", True
xreply = MsgBox("Is this page for women? Record:" & i, vbYesNo, "Gender Checker")
If xreply = vbYes Then
ActiveSheet.Range("C" & i).Value = vbYes
End If
Use this:
Sub ReturnToWindows()
Application.SendKeys ("%{TAB}")
DoEvents
End Sub
Must be run while you are in Excel rather than the VBE.