Sendkeys does not always work with vba - vba

I have this problem where SendKeys works only at times. I am not able to figure when it works either. I tried using the following commands,
Application.SendKeys "{ENTER}", True
Application.SendKeys "~"
I have also tried adding a timer before as well as after the sendkey command. i tried changing True to False.. but nothing seems to work.
lbr = Sheet2.Range("a" & lb).Value
IE.Document.getElementById("sample-1").Value = lbr
IE.Document.getElementById("sample-1").Focus
'Application.SendKeys "~"
Application.SendKeys "{ENTER}", True
'Application.SendKeys "{ENTER}"
'Application.SendKeys "{ENTER}", False
Can someone please suggest a solution or an alternative.
Thank you..

Related

WORD 2019 Crashes When Using Macro on Large Documents

I wrote the 1st ever macro.(Windows 10, WORD 2019)
I'm trying to find words that start with a capital letter in Standard style and continue to have Italic style.
Unfortunately, if I search a document using too many letters in the query - the macro closes (after checking, for example, 1.5 pages) or resets the WORD program.
If I reduce the number of words searched - the macro starts to run longer and longer.
With, for example, a search for 1 letter (U) instead of 32 (ABCDEFGHIJKLŁMNOPQRSTUVWXYZĆŚŃŻŹ) - it does not crash the program.
I tried to add
Application.ScreenUpdating = False at the beginning and
Application.ScreenUpdating = True at the end of the code but it doesn't help much.
Sub Makro1()
Dim Rng As Range
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.find.ClearFormatting
With Selection.find.Font
.Bold = False
.Italic = False
End With
Selection.find.Replacement.ClearFormatting
With Selection.find
.Text = "U"
'.Text = "([ABCDEFGHI])"
'.Text = "([ABCDEFGHI])"
'.Text = "([JKLŁMNOP])"
'.Text = "([QRSTUVWX])"
'.Text = "([YZĆŚŃŻŹ])"
'.Text = "([ABCDEFGHIJKLŁMNOPQRSTUVWXYZĆŚŃŻŹ])"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=2
Set Rng = Selection.Range
If Rng.Italic = True Then
MsgBox "FIND"
End
If Rng.Italic = False Then
Call Makro1
End If
End If
Call Makro1
End Sub
Thanks but your code didn't work. I change the code to:
If .Words.Last.Characters(2).Font.Italic = True Then
.Characters(1).Font.Italic = True
End If
.find.Execute
but it only worked sometimes. When I enabled the macro on a longer text, the macro would hang, show error 5941 "collection object not exist" and stop on the line:
If .Words.Last.Characters(2).Font.Italic = True Then
I spent a lot of time before I discovered why. It turns out that the macro crashes because sometimes there is a punctuation mark in the text next to a capital letter, e.g. period comma...etc. e.g A. B; C: D., The code would have to be improved to ignore this. I try add .IgnorePunct = True after .MatchCase = True but didn't help and macro still crashes
I try change code:
.Text = "<[A-Z][!.,;:„”#$%-+=[\[/[//[#[?[![#[$[%[*[([)[&[*[{[}]*>"
Macro fix some errors in text, work longer but still somewhere is an unacceptable sign after a character with a capital letter and the macro crashes.
Add more unwanted signs
.Text = "<[A-Z][!.,;:„”#$%-+=[\[/[//[#[?[![#[$[%[*[([)[&[*[{[}[<[>_|` - …]*>"
and still the macro crashes.
After rewriting the code to show live which words it checks, I was able to understand in part why the macro crashes.
Problem is hard space:
1 and the comma after digit
if I use normal space instead of hard space - macro work OK.
If change to N = 5, to N = 5 , also work OK.
Another place with STOP working:
2
3
I don't know what other adjustments to make so that the macro doesn't hang up in these places.
[EDIT]
I don't know too much what I'm doing, but I changed the code to:
Sub m1select()
Application.ScreenUpdating = False
With Selection.find
.Text = "<[A-Za-z0-9][! ^13.^s^t^+^=,;:„”#$%-+=[\[[\][\\[\/[\//[\#[\?[\![\#[\$[\%[\*[\([\)[\&[\*[\{[\}[\<[\>_|` - …-]*>"
.MatchWildcards = True
.Execute Forward:=True, Wrap:=wdFindStop
End With
With ActiveDocument.Content
Do While Selection.find.Found
If Selection.Words.Last.Characters(1).Font.Italic = True Or Selection.Words.Last.Characters(2).Font.Italic = True Then
Selection.Font.Italic = True
End If
Selection.find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub
and it works. It now corrects all words with partial Italic font not just capitalized.
Admittedly, it does it slowly because I used "Select" , but that way I can see what character the macro hangs on and add it to the exclusion in after the [!
( as all the time is Application.ScreenUpdating = True)
Doesn't work on expressions with a single U e.g.
U letter (after correction it should be U letter) but I make it myself with another script.
You guided me to the solution.
The problem was calling the macro in a loop using Call.
After adding START: at the beginning (and then the rest of the code) and instead of "Call Macro 1" writing "GoTo START" in two places solved the problem.
you're not finishing your code correctly.
When calling a macro from that macro you're creating a loop which never ends. By calling macro1 all the time, the runtime will terminate the Word Application after too many iterations.
You probably don't need to loop (which is a wired loop you created there) through the selection.
The Find-Object provides everything you need. To write all capital letters which are the first ones in a word to italic, when it's not bold or underlined, you could use this, for example:
Sub m()
With ActiveDocument.Content.Find
.Text = "<[A-Z]"
.Style = "Standard"
.Font.Bold = False
.Font.Underline = False
.MatchWildcards = True
.MatchCase = True
.Replacement.Font.Italic = True
.Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
End With
End Sub
If you want to set the first capital character of a word to italic, when the secnd character is italic too, you have to loop over all possible words:
Sub m1()
With ActiveDocument.Content
With .Find
.Text = "<[A-Z]*>"
.MatchWildcards = True
.MatchCase = True
.Execute Forward:=True, Wrap:=wdFindStop
End With
Do While .Find.Found
If .Words.Last.Characters(2).Font.Italic = True Then .Font.Italic = True
.Find.Execute
Loop
End With
End Sub
You could specify other letters like you did above if you need/want.
If you need more precise selection criteria, you can search them on the help page:
https://learn.microsoft.com/en/office/vba/api/word.find
Good Luck

Next File in the DIR does not open

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

Replace text in word document with content control objects

i have many documents with variable-words inside brackets like this:
[my_word]
My code already finds all those words and i save them as String.
Now I need a function to replace this String with a ContentControl Element. Is this possible? Because I first need to generate an element, then change the text inside and the tag of it, both with [my_word].
Any help is appreciated.
My Code so far looks like this (right now it is possible to replace one word at a time with a control element; I would like to replace all inside on macro. Word tells me it is not possible to replace multiple Selections, so I would have to rerun this macro mutliple times manually..)
Sub ReplaceTags()
'
' ReplaceTags Macro
'
'
Selection.Find.ClearFormatting
With Selection.Find
.Text = "\<?*\>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.Range.ContentControls.Add (wdContentControlText)
End Sub
EDIT:
I worked on my code a little bit and found a solution to replace the text I am looking for:
Sub ReplaceTags()
'
' ReplaceTags Macro
'
'
With Selection.Find
.ClearFormatting
.Text = "\<?*\>"
.Execute Forward:=True
.MatchWildcards = True
End With
If Selection.Find.Found = True Then
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.ParentContentControl.Tag = Selection.Text
End If
End Sub
Still I am not quite sure how to do this on the complete document without having to click "run macro" a whole lot of times
EDIT(EDIT):
I solved it. In case somebody has the same problem in future:
Sub ReplaceAllTags()
'
' ReplaceAllTags Macro
'
'
For i = 0 To ActiveDocument.Words.Count
Selection.EscapeKey
Application.Run MacroName:="ReplaceTags"
Next
End Sub
ReplaceTags() is the same function as above.

How do I SendKeys an ALT TAB?

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.

VBA Running when Excel closed

I have a challenge, for me at least, I cannot deal with apparently. Can somebody help me or advise on how to make the macro run when Excel is closed?
How can I make the macro run when the Excel is closed via VBA?
Sub Upload0()
' Upload Webpage content
Application.OnTime Now + TimeValue("00:00:15"), "Upload0"
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://cetatenie.just.ro/ordine/articol-11", Destination:=Range("A1"))
.Name = "CetatenieOrdine"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 1
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
' Deletes empty cells
Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
' Adjust column width and delet useless rows
Rows("1:31").Select
Selection.Delete Shift:=xlUp
Range("B28").Select
Selection.End(xlDown).Select
Rows("17:309").Select
Selection.Delete Shift:=xlUp
End Sub
Many Thanks to all!
1: Define a boolean flag in a module Public blnClosedVBA as Boolean and set it to true in your VBA routine before closing the workbook. Then in your Workbook_BeforeClose event handler (under ThisWorkbook), do this:
If blnClosedVBA = True Then
Cancel = True 'Stops the workbook from closing
'Rest of your code here
blnClosedVBA = False ' Set so next time you try to close the workbook, it actually closes
'Workbook.Close or ThisWorkbook.Close - depends on your answer to my question below
That will run the routine only if you have triggered the close event yourself. At the end of the routine, setting the flag to False and triggering another Workbook.Close will close the workbook
2: Which workbook should it work for? Should it be 'ThisWorkbook' (the one from which you're running the code), 'ActiveWorkbook' (the one activated), or another one?
1.How can I make the macro run when the workbook is closed via VBA?
Short answer: you can't do that. Your code is part of the workbook and it can't run unless the workbook is loaded in Excel. You might be able to move the code to a separate add-in workbook that you elect to load by default (using "Excel Options|Add-Ins") when Excel starts. But Excel would still need to be running somewhere on your computer.
You could write a completely separate program that does what you want, writing the results of the web query into an Excel workbook. I'm assuming here that you want the workbook to always contain up-to-date data when it's referenced by yourself (when Excel is running of course) or some other resource. If you can acquire a copy of Visual Basic 6 (it may not be possible to achieve this legally) then that's mostly syntactically the same as VBA. Next closest would be VB.Net. This is going to be technically somewhat complex.
2.Also, I have issue making this macro working ONLY for one workbook but not active ones:
This one we can deal with: this line:
With ActiveSheet.QueryTables.Add(Connection:= _
means that the following code will always run against the worksheet that has the focus (i.e. is "active" - the sheet that would receive keyboard input if you typed something). That's what ActiveSheet does. Try replacing `ActiveSheet with something likeThisWorkbook.Sheet1, whereSheet1` is the name for the sheet that you see in the "Properties" window in the VBA editor where it says "(Name)".