Create Shortcut via VBA - excel

I wonder if it's possible to make a shortcut with multiple targets, because my code doesn't work with 3 paths. Below code and screenshots.
Can you help? Thank you all in advance
https://ibb.co/pWs87P9
I want something, like in the screenshot below (I've done it manually)
https://ibb.co/9tH4Rx5
C:\Windows\System32\notepad.exe "C:\Temp Logs\app.vbs" "C:\Temp Logs\try.bat"
Sub aa()
Dim sShortcutLocation As String
sShortcutLocation = "C:\Temp Logs\AA.lnk"
With CreateObject("WScript.Shell").CreateShortcut(sShortcutLocation)
.TargetPath = "C:\Windows\System32\notepad.exe ""C:\Temp Logs\app.vbs"""
.Arguments = "C:\Temp Logs\try.bat"
.Description = "Shortcut to the file"
.Save
End With
End Sub

Related

Inputbox selection causing: "Text is not valid." Error [duplicate]

The current function I use to collect text InputBox can't accept more than 255 characters apparently, and I need to be able to collect more than that? Is there a parameter or different function I can use to increase this limit?
To be pedantic, the Inputbox will let you type up to 255 characters, but it will only return 254 characters.
Beyond that, yes, you'll need to create a simple form with a textbox. Then just make a little "helper function" something like:
Function getBigInput(prompt As String) As String
frmBigInputBox.Caption = prompt
frmBigInputBox.Show
getBigInput = frmBigInputBox.txtStuff.Text
End Function
or something like that...
Thanks BradC for the info that. My final code was roughly as follows, I have a button that calls the form that I created and positions it a bit as I was having some issues with the form being in the wrong spot the everytime after the first time I used.
Sub InsertNotesAttempt()
NoteEntryForm.Show
With NoteEntryForm
.Top = 125
.Left = 125
End With
End Sub
The userform was a TextBox and two CommandButtons(Cancel and Ok). The code for the buttons was as follows:
Private Sub CancelButton_Click()
Unload NoteEntryForm
End Sub
Private Sub OkButton_Click()
Dim UserNotes As String
UserNotes = NotesInput.Text
Application.ScreenUpdating = False
If UserNotes = "" Then
NoteEntryForm.Hide
Exit Sub
End If
Worksheets("Notes").ListObjects("Notes").ListRows.Add (1)
Worksheets("Notes").Range("Notes").Cells(1, 1) = Date
Worksheets("Notes").Range("Notes").Cells(1, 2) = UserNotes
Worksheets("Notes").Range("Notes").Cells(1, 2).WrapText = True
' Crap fix to get the wrap to work. I noticed that after I inserted another row the previous rows
' word wrap property would kick in. So I just add in and delete a row to force that behaviour.
Worksheets("Notes").ListObjects("Notes").ListRows.Add (1)
Worksheets("Notes").Range("Notes").Item(1).Delete
NotesInput.Text = vbNullString
NotesInput.SetFocus ' Retains focus on text entry box instead of command button.
NoteEntryForm.Hide
Application.ScreenUpdating = True
End Sub
I don't have enough rep to comment, but in the sub form_load for the helper you can add:
me.AutoCenter = True
Outside of that form, you can do it like this:
NoteEntryForm.Show
Forms("NoteEntryForm").AutoCenter = True
My Access forms get all confused when I go from my two extra monitors at work to my one extra monitor at home, and are sometimes lost in the corner. This AutoCenter has made it into the form properties of every one of my forms.

Write the date in BDS function automatically

I'm working with data from Bloomberg. My code is :
Sub Code_Fin()
Sheets("SPX").Cells(2, 3).Formula = "=BDS(""SPX Index"", ""INDX_MEMBERS"",
""END_DATE_OVERRIDE=20210810"",""cols=1;rows=1000"")"
End Sub
Do you know please, how replace the ""END_DATE_OVERRIDE=20210810"" by something like ""END_DATE_OVERRIDE=today()"" ? I would like to change the date automatically.
Thank you !

Extract file names from a File Explorer search into Excel

This has been bugging me for while as I feel I have few pieces of the puzzle but I cant put them all together
So my goal is to be able to search all .pdfs in a given location for a keyword or phrase within the content of the files, not the filename, and then use the results of the search to populate an excel spreadsheet.
Before we start, I know that this easy to do using the Acrobat Pro API, but my company are not going to pay for licences for everyone so that this one macro will work.
The windows file explorer search accepts advanced query syntax and will search inside the contents of files assuming that the correct ifilters are enabled. E.g. if you have a word document called doc1.docx and the text inside the document reads "blahblahblah", and you search for "blah" doc1.docx will appear as the result.
As far as I know, this cannot be acheived using the FileSystemObject, but if someone could confirm either way that would be really useful?
I have a simple code that opens an explorer window and searches for a string within the contents of all files in the given location. Once the search has completed I have an explorer window with all the files required listed. How do I take this list and populate an excel with the filenames of these files?
dim eSearch As String
eSearch = "explorer " & Chr$(34) & "search-ms://query=System.Generic.String:" & [search term here] & "&crumb=location:" & [Directory Here] & Chr$(34)
Call Shell (eSearch)
Assuming the location is indexed you can access the catalog directly with ADO (add a reference to Microsoft ActiveX Data Objects 2.x):
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String
cn.Open "Provider=Search.CollatorDSO;Extended Properties='Application=Windows'"
sql = "SELECT System.ItemNameDisplay, System.ItemPathDisplay FROM SystemIndex WHERE SCOPE='file:C:\look\here' AND System.Kind <> 'folder' AND CONTAINS(System.FileName, '""*.PDF""') AND CONTAINS ('""find this text""')"
rs.Open sql, cn, adOpenForwardOnly, adLockReadOnly
If Not rs.EOF Then
Do While Not rs.EOF
Debug.Print "File: "; rs.Collect(0)
Debug.Print "Path: "; rs.Collect(1)
rs.MoveNext
Loop
End If
Try using the next function, please:
Function GetFilteredFiles(foldPath As String) As Collection
'If using a reference to `Microsoft Internet Controls (ShDocVW.dll)_____________________
'uncomment the next 2 lines and comment the following three (without any reference part)
'Dim ExpWin As SHDocVw.ShellWindows, CurrWin As SHDocVw.InternetExplorer
'Set ExpWin = New SHDocVw.ShellWindows
'_______________________________________________________________________________________
'Without any reference:_____________________________________
Dim ExpWin As Object, CurrWin As Object, objshell As Object
Set objshell = CreateObject("Shell.Application")
Set ExpWin = objshell.Windows
'___________________________________________________________
Dim Result As New Collection, oFolderItems As Object, i As Long
Dim CurrSelFile As String
For Each CurrWin In ExpWin
If Not CurrWin.Document Is Nothing Then
If Not CurrWin.Document.FocusedItem Is Nothing Then
If left(CurrWin.Document.FocusedItem.Path, _
InStrRev(CurrWin.Document.FocusedItem.Path, "\")) = foldPath Then
Set oFolderItems = CurrWin.Document.folder.Items
For i = 0 To oFolderItems.count
On Error Resume Next
If Err.Number <> 0 Then
Err.Clear: On Error GoTo 0
Else
Result.Add oFolderItems.item(CLng(i)).Name
On Error GoTo 0
End If
Next
End If
End If
End If
Next CurrWin
Set GetFilteredFiles = Result
End Function
Like it is, the function works without any reference...
The above function must be called after you executed the search query in your existing code. It can be called in the next (testing) way:
Sub testGetFilteredFiles()
Dim C As Collection, El As Variant
Set C = GetFilteredFiles("C:\Teste VBA Excel\")'use here the folder path you used for searching
For Each El In C
Debug.Print El
Next
End Sub
The above solution iterates between all IExplorer windows and return what is visible there (after filtering) for the folder you initially used to search.
You can manually test it, searching for something in a specific folder and then call the function with that specific folder path as argument ("\" backslash at the end...).
I've forgotten everything I ever knew about VBA, but recently stumbled across an easy way to execute Explorer searches using the Shell.Application COM object. My code is PowerShell, but the COM objects & methods are what's critical. Surely someone here can translate.
This has what I think are several advantages:
The query text is identical to what you wouold type in the Search Bar in Explorer, e.g.'Ext:pdf Content:compressor'
It's easily launched from code and results are easily extracted with code, but SearchResults window is available for visual inspection/review.
With looping & pauses, you can execute a series of searches in the same window.
I think this ability has been sitting there forever, but the MS documentation of the Document object & FilterView method make no mention of how they apply to File Explorer.
I hope others find this useful.
$FolderToSearch = 'c:\Path\To\Folder'
$SearchBoxText = 'ext:pdf Content:compressor'
$Shell = New-Object -ComObject shell.application
### Get handles of currenlty open Explorer Windows
$CurrentWindows = ( $Shell.Windows() | Where FullName -match 'explorer.exe$' ).HWND
$WinCount = $Shell.Windows().Count
$Shell.Open( $FolderToSearch )
Do { Sleep -m 50 } Until ( $Shell.Windows().Count -gt $WinCount )
$WindowToSerch = ( $Shell.Windows() | Where FullName -match 'explorer.exe$' ) | Where { $_.HWND -notIn $CurrentWindows }
$WindowToSearch.Document.FilterView( $SearchBoxText )
Do { Sleep -m 50 } Until ( $WindowToSearch.ReadyState -eq 4 )
### Fully-qualified name:
$FoundFiles = ( $WindowToSearch.Document.Folder.Items() ).Path
### or just the filename:
$FoundFiles = ( $WindowToSearch.Document.Folder.Items() ).Name
### $FoundFIles is an array of strings containing the names.
### The Excel portion I leave to you! :D

How to retrieve specific information from XML type document

I`m working on a VBA macro in Excel, to gather information from a CNC program code.
So far, I have gotten Material type, thickness, x & Y sizes, and qty used.
I`m trying to get the 'cutting length' now - so I can use it in costing calculations.
Here is the XML code segment :
<Info num="6" name="Tools">
<MC machine="psys_ETN_5">
<Tool name="TN901" length="16262.96209" time="53.72817301" cutoutArea="8138.657052"/>
</MC>
</Info>
There are lots of 'Info' lines.
There may be more than one 'Tool' line, but I`m only after anything from line with 'TN901'.
The data I`m trying to capture is the value of 'Length="######.##"'
I`ve captured everything else I need from code like this :
<Material>316</Material>
<SheetX>2000</SheetX>
<SheetY>1000</SheetY>
<Thickness>3</Thickness>
</Material>
using code like this:
For Each nodemat In XMLDataDrg.SelectNodes("//Material")
Matl = nodemat.Text
Worksheets("Sheet4").Range("H" & RowA).Value = Matl
Next
For Each nodesht In XMLDataDrg.SelectNodes("//Thickness")
Thk = nodesht.Text
Worksheets("Sheet4").Range("I" & RowA).Value = Thk
Next
But that type of code does not get the cutting length.
Any help please ? :)
Thanks
Simon
Thickness is saved as XML element in your example.
The length is stored as an XML attribute.
(see https://www.xmlfiles.com/xml/xml-attributes/)
To read an XML attribute please have a look at:
Read XML Attribute VBA
Based on the code presented there you should be able to solve your issue with:
'Include a reference to Microsoft XML v3
Dim XMLDataDrg As DOMDocument30
Set XMLDataDrg = New DOMDocument30
XMLDataDrg.Load ("C:\...\sample.xml")
'...
Dim id As String
id = XMLDataDrg.SelectSingleNode("//Info/MC/Tool").Attributes.getNamedItem("length").Text
You can use an xpath to restrict to Tool elements with attribute name having value TN901 then loop all the attributes and write out. I am reading your XML from a file on desktop.
Option Explicit
Public Sub test()
Dim xmlDoc As Object
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
With xmlDoc
.validateOnParse = True
.setProperty "SelectionLanguage", "XPath"
.async = False
If Not .Load("C:\Users\User\Desktop\Test.xml") Then
Err.Raise .parseError.ErrorCode, , .parseError.reason
End If
End With
Dim elem As Object, attrib As Object
For Each elem In xmlDoc.SelectNodes("//Tool[#name='TN901']")
For Each attrib In elem.Attributes
Debug.Print attrib.nodeName, attrib.Text
Next
Next
End Sub
Result:

How to access SAP using Excel VBA?

I am trying to log on to SAP. The Excel VBA code gives me a popup window confirming my information however when I submit the form it does not take me to a new SAP window.
Additionally is there a way to automate all the popup boxes asking for confirmation on my information? I want this code eventually to run at certain times of the day, and I might not be available to input any data.
Sub login1()
Dim sap As Object
Dim conn As Object
Set sap = CreateObject("SAP.Functions")
Set conn = sap.Connection
conn.System = "System Test Environment"
conn.client = "100"
conn.user = "user"
conn.Password = "password"
conn.Language = "EN"
If conn.logon(0, False) <> True Then
MsgBox "Logon to the SAP system is not possible", vbOKOnly, "Comment"
Else
End If
End Sub
This Macro will never open a SAP Window - it will create an SAP-Object within VBA where you can work with SAP-RFC-Functions. (Reading Data from SAP, Writing Data into SAP)
In your version the SAP connection will be unaccessible after "End Sub". You have to declair the Object outside the sub.
This works silent (without dialog) for me:
Dim sap As Object
Public Function login1() As Boolean
Set sap = CreateObject("SAP.Functions")
sap.Connection.System = "System Test Environment"
sap.Connection.client = "100"
sap.Connection.user = "user"
sap.Connection.Password = "password"
sap.Connection.Language = "EN"
If sap.Connection.logon(0, False) <> True Then
sap.RemoveAll
MsgBox "Logon to the SAP system is not possible", vbOKOnly, "Comment"
Else
login1 = true
End If
End Function
Public Function SAPLogoff()
On Error Resume Next
sap.RemoveAll
sap.Connection.logoff
LoggedOn = False
Set sap = Nothing
'Set conn = Nothing
End Function
Since you want to "open a new SAP Window" you have to make a different approach!
At First try to open the new instance of SAP from the DOS Commandline with "sapshcut":
C:\Program Files (x86)\SAP\FrontEnd\SAPgui\sapshcut.exe -system="System Test Environment" -client="100" -user="user" -password="password" -language="EN"
If your SystemName has no Spaces (and I belive so!) then you can write it also like:
C:\Program Files (x86)\SAP\FrontEnd\SAPgui\sapshcut.exe -system=SystemTestEnvironment -client=100 -user=user -password=password -language=EN
When this call works with your credentials, then you can transfer it to Excel like this:
Sub login1()
Call Shell("C:\Program Files (x86)\SAP\FrontEnd\SAPgui\sapshcut.exe -system=SystemTestEnvironment -client=100 -user=user -password=password -language=EN",vbNormalFocus)
End Sub
You could also add a transaction by adding "-command=your_tcode" to the String.
If your have spaces in the parameters and you could only start it with -system="System Test Environment" from the Commanline, you will have to escape this in Excel with -system="""System Test Environment""" (!)

Resources