Protect VBA code

This is an upgrade from Lance’s Online VBA Hiding Tool – HideMyVBA.com, which is a FREE tool/service that you can use to hide your VBA code from people who may be using your workbooks. This can help protect your intellectual property.  The tool will protect VBA code from being viewed or modified, yet it will still preserve the full functionality of the workbook.

It has 2 options to protect code:
  1. Making modules very hidden (very basic protection)
  2. Modifying the signature on GC=/CMG=/DPB= to GC./CMG./DPB (better protection). The best explanation I found came from this post.
I made some improvements over the original author’s version:
  • restored all the offuscated code
  • get rid of the Kill statements (commented out). If really needed, better use Recycle bin, which needs a lot of code on the other hand
  • get rid of Dir statements also -in order not to mess with defaults-
  • fullfilled variable declarations -all modules set to Option Explicit-
  • made tool 2003 compatible (added #If were needed). Most of the code came from this post from Đức Thanh Nguyễn, and some other answers found there.
  • improved the performance of worksheet crack (the password is incrementally computed, not need to create on every step), and a DoEvents inserted in order to stop process if needed.
  • added some associated functions that were missing (ExportModules did let user select a folder -and was pointing to a not declared variable-). 
There should be made the same disclaimer note as on the original tool: 
Run this code at your own risk. This software is provided "as is," without warranty of any kind, express or implied. In no event shall the author or contributors be held liable for any damages arising in any way from the use of this software. The creator of this workbook is not responsible for corruption to workbooks, damages that may occur while using this workbook or loss of data that might be associated with the workbook. Always keep a backup copy of all of your workbooks before running any programs that modify them. Do not run this program on a master copy.
Download my version from HideMyVBA_improved. It’s realeased under the same Creative commons license (Creative Commons) the original author (Lance) stated for his version -although he not declared which one it’s-.

There are other options on the net, but this is free, and open source.

Read Ifc geometry info with VBA

Following is simple code to read a Ifc file structure and get the basic geometry information stored on it, which can then feed the Excel 3Dviewer.

Work is in progress, so will update this post as code gets out… to link the Excel 3DViewer and ammendments to code

Option Explicit
Private Const MODULE_NAME As String = "mIFC"

Private Type tXYZ
    X As Double
    Y As Double
    Z As Double
End Type
Private Type tPolyLoop
    Direction As tXYZ
    FaceOuterBound As Long
    Index() As Long
End Type
Private Type tIfcDeclaration
    hnd As Long
    IfcCode As String
    Parameters() As String
End Type

Private Sub sIFC_Geometry_Read()
    Dim FilePath As String
    
    FilePath = Application.GetOpenFilename("Ifc Files (*.ifc), *.ifc")
    If VBA.CVar(FilePath) = False Then
        MsgBox "File open failed" & VBA.IIf(FilePath, " [" & FilePath & "]", ". No file")
        Exit Sub
    End If
    
    Call fIFC_Geometry_Read(FilePath)
End Sub

Private Sub InsertionSort_Lng(ByRef Data() As Long)
' Best algorithm for an almost sorted array
    Dim lngCounter1 As Long, lngCounter2 As Long
    Dim DataTemp As Long

    For lngCounter1 = LBound(Data) To UBound(Data)
        DataTemp = Data(lngCounter1)
        For lngCounter2 = lngCounter1 To 1 Step -1
            If Data(lngCounter2 - 1) > DataTemp Then
                Data(lngCounter2) = Data(lngCounter2 - 1)
            Else
                Exit For
            End If
        Next lngCounter2
        Data(lngCounter2) = DataTemp
    Next lngCounter1
End Sub

Private Function fIFC_Geometry_Read(ByVal FilePath As String)
    Dim aPtrs() As Long, cntIfc As Long
    Dim aIfcDeclarations() As tIfcDeclaration, aIfcDeclarations_() As tIfcDeclaration
    
    Dim Lines() As String, txtLine As String, cntLine As Long, cntLine_ As Long
    Dim IfcCode As String
    Dim cntItem As Long
    Dim cntCartesianPoint As Long, cntDirection As Long, _
        cntFace As Long, cntFaceOuterBound As Long, cntPolyLoop As Long
    Dim aIfcPts() As tXYZ, aIfcDirections() As tXYZ, aIfcFaces() As tXYZ, aIfcPolyLoops() As tPolyLoop
    Dim ChrPos As Long

    Call fFile_Load(Lines(), FilePath)
    
    ' Get declarations(pointer/DeclarationType/Parameters)
    ReDim Preserve aIfcDeclarations(LBound(Lines) To UBound(Lines))
    ReDim Preserve aPtrs(LBound(Lines) To UBound(Lines))
    For cntLine = cntLine To UBound(Lines)
        Lines(cntLine) = VBA.Trim$(Lines(cntLine))
    Next cntLine
    cntLine = LBound(Lines)
    Do Until VBA.Trim$(Lines(cntLine)) Like "DATA;"
        cntLine = cntLine + 1: If cntLine > UBound(Lines) Then Exit Do
        'DoEvents
    Loop
    cntLine_ = UBound(Lines)
    Do Until VBA.Trim$(Lines(cntLine_)) Like "ENDSEC;"
        cntLine_ = cntLine_ - 1: If cntLine < LBound(Lines) Then Exit Do
        'DoEvents
    Loop
    For cntLine = cntLine To cntLine_
        txtLine = Lines(cntLine)
        If VBA.Left$(txtLine, 2) Like "/[*]" Then ' comment
            Do Until VBA.Right$(txtLine, 2) Like "[*]/"
                cntLine = cntLine + 1: If cntLine > UBound(Lines) Then Exit Do
                'DoEvents
            Loop
        Else 'data...
            cntIfc = cntIfc + 1
            ChrPos = VBA.InStr(1, txtLine, "=")
                aIfcDeclarations(cntIfc).hnd = VBA.CLng(VBA.Mid$(txtLine, 2, ChrPos - 2))
                aPtrs(cntIfc) = aIfcDeclarations(cntIfc).hnd
                IfcCode = VBA.Mid$(txtLine, ChrPos)
            ChrPos = VBA.InStr(1, IfcCode, "(")
                aIfcDeclarations(cntIfc).IfcCode = VBA.Mid$(IfcCode, 1, ChrPos - 1)
            txtLine = VBA.Mid$(txtLine, ChrPos + 1)
            txtLine = VBA.Mid$(txtLine, 1, VBA.Len(txtLine) - 1)
                aIfcDeclarations(cntIfc).Parameters() = VBA.Split(txtLine, ",")
        End If
        'DoEvents
    Next cntLine
    ReDim Preserve aIfcDeclarations(cntLine)
    ReDim Preserve aPtrs(cntLine)
    
    ' Sort declarations... by hnd value (best suited for the almost sorted array is the insertion sort)
    ' https://stackoverflow.com/questions/42598189/insertion-sort-in-vba-not-working
    aIfcDeclarations_() = aIfcDeclarations()
    Call InsertionSort_Lng(aPtrs)
    For cntLine = LBound(aPtrs) To UBound(aPtrs)
        aIfcDeclarations_(cntLine) = aIfcDeclarations(aPtrs(cntLine))
    Next cntLine
    
'---

    cntCartesianPoint = -1
    cntDirection = -1
    cntCartesianPoint = -1
    cntPolyLoop = -1
    For cntLine = LBound(aIfcDeclarations_) To UBound(aIfcDeclarations_)
'!!!!!!!!!!!!
'hnd = fIfcCode_BinarySearch(Target, aPtrs(), LBound(aPtrs), UBound(aPtrs))
'!!!!!!!!!!!!
        With aIfcDeclarations_(cntLine)
            If IfcCode Like "IFCCARTESIANPOINT" Then
            '#38 = IFCCARTESIANPOINT((4.30558740099853, 12.9543948697056, 9.));
                cntCartesianPoint = cntCartesianPoint + 1: ReDim Preserve aIfcPts(0 To cntCartesianPoint)
                For cntItem = LBound(.Parameters) To UBound(.Parameters)
                Next cntItem
            ElseIf IfcCode Like "IFCDIRECTION" Then
            '#18 = IFCDIRECTION((0., 0., 1.));
                cntDirection = cntDirection + 1: ReDim Preserve aIfcPts(0 To cntDirection)
                For cntItem = LBound(.Parameters) To UBound(.Parameters)
                Next cntItem
            ElseIf IfcCode Like "IFCFACE" Then
            '#240 = IFCFACE((#241));
                cntFace = cntFace + 1: ReDim Preserve aIfcFaces(0 To cntCartesianPoint)
                For cntItem = LBound(.Parameters) To UBound(.Parameters)
                Next cntItem
            ElseIf IfcCode Like "IFCFACEOUTERBOUND" Then
            ''#241 = IFCFACEOUTERBOUND(#242, .T.);
            '    'cntFaceOuterBound = cntFaceOuterBound + 1: ReDim Preserve aIfcPolyLoops(0 To cntFaceOuterBound)
            '    ' search for aPolyLoops...
            ElseIf IfcCode Like "IFCPOLYLOOP" Then
            '#242 = IFCPOLYLOOP((#40, #42, #54));
                cntPolyLoop = cntPolyLoop + 1: ReDim Preserve aIfcPts(0 To cntPolyLoop)
                For cntItem = LBound(.Parameters) To UBound(.Parameters)
                Next cntItem
            Else
            '#29 = IFCCARTESIANPOINTLIST3D(((3.13934927250691, 10.0530219646776, 8.), (10.3358918702723, 11.1339255959626, 6.), (4.30558740099853, 12.9543948697056, 9.), (2.65578712166892, 16.4815540875827, 10.), (8.71453642334491, 16.7944472440073, 5.)), $);
            '#30 = IFCTRIANGULATEDIRREGULARNETWORK(#29, $, .F., ((3, 5, 4), (2, 5, 3), (3, 4, 1), (2, 3, 1)), $, (0, 0, -1, 0));
            End If
        End With
    Next cntLine
End Function

Private Function fIfcCode_BinarySearch(ByVal Target As Long, _
                                       ByRef aData() As Long, _
                                       Optional ByVal nFirst As Long = 0, _
                                       Optional ByVal nLast As Long = -1) As Long
    Dim nMiddle As Long, Value As Long
    
    If nFirst > nLast Then
        nFirst = LBound(aData)
        nLast = UBound(aData)
    End If
    If nFirst < LBound(aData) Then nFirst = LBound(aData)
    If nLast > UBound(aData) Then nLast = UBound(aData)
    
    Do While True
        If nFirst > nLast Then fIfcCode_BinarySearch = -1: Exit Do ' Failed to find search arg
        
        nMiddle = (nLast + nFirst) \ 2
        Value = aData(nMiddle)
        If Value > Target Then
            nLast = nMiddle - 1
        ElseIf Value < Target Then
            nFirst = nMiddle + 1
        Else
            fIfcCode_BinarySearch = nFirst
            Exit Do
        End If
    Loop
End Function

Excel graphical stuff

Fraqcel is an open-source fractal generator for Microsoft Excel 2007 and later on Windows.  There are some optional DLL to perform multithreaded calculations and increased performance

Excel 3D rendering. It’s an old post, but have lost track for some time. Now a direct link will reside here. The link came from a comment of this other one.

Gamasutra – Microsoft Excel: Revolutionary 3D Game Engine?

All for now…

N-Body simulation Excel

N-Body simulation Excel

Following this Youtube video from s0lly, and the related project on GitHub, downloaded it and started some modifications:
  • simplyfied formulation (easy to follow)
  • collision detection (bigger body increases mass, although does not varies radius…). From this point there is some room for tool improvements I may explore in future: angular velocities, radius and gravity variations (density), particle creation from collision, accretion,…
  • system for trajectory tracking, would be nice for a well curated initial data, although a bit chaotic if random data is provided, specially on “Planetary system” setting on TRUE…
  • chart exporting to JPG on each step (so it can easily turn to GIF)
  • final but not least, rearranged old VBA and new code for better performance/new capabilities
I could not get good results on the Planetary configuration, which I should investigate further, but the file continues working for the chaotic data, so the maths should be OK there.
I did also wanted the GIF frames automated, but the Chart refuses to export if played on a Do-Loop (the DoEvents would not make it work if used), problem is related to Excel chart not refreshing at the pace the values are computed. So there is a chance to use SendKeys to get this thing automated. Running on Excel 2003 is OK for main bodies (even if there is no place for more than 85 trajectories… could transpose array to solve this issue), but the track paths do no show… maybe is the bubble size but did not dig enough to narrow down the causes for this behaviour.

You can grab my modified file here: N-Body Simulator_revisited

Excel-DNA

Excel-DNA = .Net and Excel integration

In order to overcome limitations due to the lack of development of the VBA language, relaying on XLL seems a right option to manipulate Excel environment via more actual languages, like C++ or the .Net flavours.
From all the solutions one can opt to deal with this XLL thing, Excel-DNA is the way to go.

Excel-DNA (Excel Dot Net Assembly) lets integrate .Net and Excel, making possible to create native .xll add-ins for Excel (using .Net programming languages, via Visual Studio), which leverages high-performance in user-defined functions (UDFs) and Excel manipulation from .Net coded applications. It also allows to customize ribbon interfaces. The add-in can be packed into a single .xll file -requiring no installation or registration, only linking from the Excel COM tab manager-.
Continue reading “Excel-DNA”

Excel to BC3

Importar presupuestos de Excel sin macros (de XLS a BC3)

Una fase del trabajo de oficina, tanto en redacción de proyectos como durante la construcción, consiste en medir y traspasar, a un documento de presupuesto, dichas mediciones. Afortunadamente se dispone de un formato de intercambio relativamente simple FIECBD/BC3 entre ellos y los programas del ramo disponen de exportación a Excel desde su formato nativo. Sin embargo este camino es unidireccional, -> de FormatoPropietario/BC3 a XLS, y el camino inverso no está cerrado, porque es específico de cada solución de exportación.

Suponiendo que se ha adoptado la muy conocida y eficiente BC3ToExcel.com, es posible convertir de BC3 a XLS, sobre el que realizar las oportunas modificaciones en una aplicación infinitamente más versátil que las aplicaciones comerciales dedicadas, porque además de poder trabajar con fórmulas, se abre a referencias de tipo “base de datos”, rangos,….

Es posible realizar la exportación desde un Libro de este tipo a formato BC3 con apenas 10 fórmulas y, no es necesario tan siquiera recurrir a macros, aunque una pequeña rutina libera del trabajo manual final necesario para tenerlo todo en orden.

Las fórmulas son las siguientes:

  • Para la hoja “CuadrodePrecios”, se ocupan dos columnas, donde se requieren las fórmulas:
    ConceptoTexto
    =SI($D#=””;””;”~C”&”|”&$D#&”|”&$E#&”|”&$F#&”|”&SUSTITUIR(TEXTO($G#;”0,00″);”,”;”.”)&”|”&TEXTO(HOY();”ddmmaa”)&”|”&$C#&”|”)=SI($D#=””;””;”~T”&”|”&$D#&”|”&$I#&”|”)

    Para la hoja “Precios Descompuestos”, se emplea una columna, con la fórmula: =SI($B#<>””;”|”&CARACTER(13)&CARACTER(10)&”~D”&”|”&$B#&”|”;SI($C#<>””;$C#&”\”&”1″&”\”&SUSTITUIR(TEXTO($F#;”0,0000″);”,”;”.”)&”\”;””))

  • Para la hoja “Presupuesto”, se ocupa el rango de columnas “Q” a “AA”, para 0 (Raiz) y 1 nivel de desglose (aunque es posible incrementarlo hasta el nivel deseado agregando más columnas por pares y editando el código de la fórmula):
  • NivelPosiciónCódigocapitulosDescompuestosCheck Nivel0 Nivel1 Mediciones
    =SI(ESBLANCO($C#);””;SUMA(LARGO($C#))-LARGO(SUSTITUIR($C#;”.”;””))+1)=SI(ESBLANCO($C#);””;SUSTITUIR($C#;”.”;”\”))=SI($B#=”#”;$D#&”#”;DESREF($T#;-1;0))=SI(B#=”#”;”~C|”&$T#&”||”&$F#&”|”&SUSTITUIR(TEXTO($O#;”0,00″);”,”;”.”)&”|”&TEXTO(HOY();”ddmmaa”)&”|”&”0″&”|”;””)=SI($B#=”#”;”|”&CARACTER(13)&CARACTER(10)&”~D|”&$T#&”|”;””)=O($B#=”B”;$B#=”C”;$B#=”D”)=SI(O($B#=”#”;$W#);$D#;””)=”~C|”&”RAIZ##”&”||”&”PROYECTO”&”|”&SUSTITUIR(TEXTO($O#;”0,00″);”,”;”.”)&”|”&TEXTO(HOY();”ddmmaa”)&”|”&”0″&”|”&”~D|”&”RAIZ##”&”|”=SI($R#=1;SI($B#=”#”;$X#&”\1\1\”;””);””)=SI($R#=1;$U#;””)=SI($R#=1;SI($B#=”#”;$V#;””);SI($R#=2;$X#&”\1\1\”;””))=SI($W#;”|”&CARACTER(13)&CARACTER(10)&”~M|”&$T#&”\”&$D#&”|”&$S#&”|”&SUSTITUIR(TEXTO($L#;”0,00″);”,”;”.”)&”|”;
      SI(Y(ESBLANCO($D#);ESBLANCO($B#);Y(NO(DESREF($B#;-1;0)=”S”));NO(DESREF($B#;-1;0)=”M”));
    SI(O($K#=””;$K#<>0); “\”&SI(ESBLANCO($F#);””;SUSTITUIR(TEXTO($F#;”0,00″);”,”;”.”))&
    “\”&SI(ESBLANCO($G#);””;SUSTITUIR(TEXTO($G#;”0,00″);”,”;”.”))&
    “\”&SI(ESBLANCO($H#);””;SUSTITUIR(TEXTO($H#;”0,00″);”,”;”.”))&
    “\”&SI(ESBLANCO($I#);””;SUSTITUIR(TEXTO($I#;”0,00″);”,”;”.”))&
    “\”&SI(ESBLANCO($J#);””;SUSTITUIR(TEXTO($J#;”0,00″);”,”;”.”))&”\”;””);””))


    En estas fórmulas el carácter “#” sustituye al número de fila en que se inserta la fórmula.
    No queda más que arrastrar las fórmulas al rango usado, y copiar, por columnas a un archivo de texto. Para las columnas de código “~D” y “~M” se hace preciso una pequeña operación manual, consistente en eliminar el primer carácter “|” y añadirlo a la cola del texto de esa columna. En todo caso, el texto de la columna siempre debe terminar con el carácter “|”.

    Finalmente será preciso añadir los parámetros de operación del archivo BC3, que son las dos líneas siguientes:
    ~V|-|FIEBDC-3/2002|-||ANSI|
    ~K|\3\3\4\2\2\2\2\EUR\|0|

    Con esto será posible disponer de un archivo de vuelta en formato BC3, listo para importar y generar los listados.

    Acompaño, a continuación, el código de la rutina que permite, para mi configuración, realizar el trabajo manual. Será preciso modificar los nombres de hojas en su caso, y seleccionar las columnas a exportar, en cada hoja, sólo las marcadas en azul.

    Sub XLSToBC3()
    ' Exporta a BC3 desde XLS

    Dim oWsh As Excel.Worksheet
    Dim hndOut As Integer
    Dim FilePath_BC3 As Variant

    ' Get filename (save file dialog)
    FilePath_BC3 = Application.GetSaveAsFilename(FileFilter:="FIEBDC-3/20## (*.bc3), *.bc3, " & _
    "All files" & "(*.*), *.*", _
    Title:="Save as BC3", _
    InitialFileName:=VBA.Environ$("UserProfile") & "\Documents\")
    If FilePath_BC3 = False Then Exit Sub ' make sure the user hasn't canceled the dialog

    hndOut = VBA.FreeFile
    Open VBA.CStr(FilePath_BC3) For Output Shared As #hndOut
    Print #hndOut, "~V|-|FIEBDC-3/2002|-||ANSI|"
    Print #hndOut, "~K|\3\3\4\2\2\2\2\EUR\|0|"

    Set oWsh = Worksheets("Cuadro de Precios"): oWsh.Activate
    Call ExportarHoja(oWsh, hndOut)

    Set oWsh = Worksheets("Precios Descompuestos"): oWsh.Activate
    Call ExportarHoja(oWsh, hndOut)

    Set oWsh = Worksheets("Presupuesto"): oWsh.Activate
    Call ExportarHoja(oWsh, hndOut)

    Close #hndOut
    End Sub

    Private Sub ExportarHoja(ByVal oWsh As Excel.Worksheet, _
    ByVal hndOut As Integer)
    Dim oSelection As Excel.Range
    Dim oColumn As Excel.Range
    Dim oCell As Excel.Range
    Dim strColumn As String

    'With oWsh
    'Set oSelection = Selection
    'If oSelection.Columns.Count = 1 Then
    'Do While Application.Intersect(oSelection, Columns("?:??")) Is Nothing
    Set oSelection = Application.InputBox("Seleccionar rango de columnas a exportar", , oSelection, , , , , Type:=8)
    'Set oSelection = Application.Intersect(oSelection, .Columns("?:??"))
    'DoEvents
    'If Application.Intersect(oSelection, .Columns("?:??")) Is Nothing Then 'Exit Do
    'Loop
    'End With

    For Each oColumn In oSelection.Columns
    strColumn = vbNullString
    For Each oCell In oColumn.Cells
    If oCell.Value2 <> vbNullString Then
    strColumn = strColumn & oCell.Value2 & vbCrLf
    End If
    Next oCell
    strColumn = VBA.Trim$(strColumn)
    If VBA.Mid(strColumn, 1, 1) = "|" Then strColumn = VBA.Mid(strColumn, 2) & VBA.Mid(strColumn, 1, 1)
    If VBA.Right(strColumn, 1) <> "|" Then strColumn = strColumn & "|"
    'MsgBox strColumn
    If strColumn <> vbNullString Then Print #hndOut, strColumn & vbNewLine
    Next oColumn
    oSelection.Select
    Set oSelection = Nothing
    End Sub

VBA check redundant variables

Following with last post, where the code was beautified, next step is to check for redundant declaration of variables. The code came from wikibooks site again, this post, but there are some limitations noted.
But I think that merging both posts, the code can be refactored to check for undeclared variables and reuse some parts of the code to get a VBA parser to other programming languages.

The following code, as it is right now, will only check for redundant declarations. The other ideas should be developed… in a near future, I hope:
‘ https://en.wikibooks.org/wiki/Visual_Basic_for_Applications/Redundant_Variables_List
Continue reading “VBA check redundant variables”

VBA Spy++ alternative

We can interact with Windows’s windows (sic) from within VBA, even if there is not a OCX we can set a reference to and deal with the external application. The usual and ‘inconvenient’ way to do so is via the SendKeys API, but it’s not the only one option out there.
VBA can be used to explore process and windows, and once we  know the window handle (or the caption and ClassName of it),  we can focus on that component and send keys specifically to that window, via SendMessage/PostMessage
So the first step should be to detect the open windows -the ones we need to interact with- (and their children), and get them in a worksheet (or wherever you want to output).
With following code from Mark Rowlinson (www.markrowlinson.co.uk), that copied from here, all windows will be reflected, in blocks of 3 columns (handle, ClassName and Caption), very convenient to get the interaction.
In order to get the list, run GetWindows procedure.
This post is somehow related to these old posts 1,2:

Option Explicit

'Declaring the necessary API functions for both 64 and 32 bit applications.
#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As LongPtr

'Performs an operation on a specified file.
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr

'Retrieves a handle to the top-level window whose class name and window name match the specified strings.
'This function does not search child windows. This function does not perform a case-sensitive search.
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

'Retrieves a handle to a window whose class name and window name match the specified strings.
'The function searches child windows, beginning with the one following the specified child window.
'This function does not perform a case-sensitive search.
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

'Sends the specified message to a window or windows. The SendMessage function calls the window procedure
'for the specified window and does not parentWindowurn until the window procedure has processed the message.
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

'Places (posts) a message in the message queue associated with the thread that created the specified
'window and parentWindowurns without waiting for the thread to process the message.
Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
#Else
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
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 lpClassName As String, ByVal lpWindowName As String) 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
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

'Constants used in API functions.
Private Const SW_HIDE As Long = 0
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWMINIMIZED As Long = 2

Private Const WM_SETTEXT = &HC
Private Const VK_RETURN = &HD
Private Const WM_KEYDOWN = &H100

Private cnt As Integer

'Used a user defined type here rather than Enum so that it works on 97
Private Type winEnum
winHandle As Integer
winClass As Integer
winTitle As Integer
winHandleClass As Integer
winHandleTitle As Integer
winHandleClassTitle As Integer
End Type

Private winOutputType As winEnum

Public Sub GetWindows()
' VBA "Clone" of Spy++ application
cnt = 0
winOutputType.winHandle = 0
winOutputType.winClass = 1
winOutputType.winTitle = 2
winOutputType.winHandleClass = 3
winOutputType.winHandleTitle = 4
winOutputType.winHandleClassTitle = 5

GetWinInfo 0&, 0, winOutputType.winHandleClassTitle
End Sub

Private Sub GetWinInfo(hParent As Long, intOffset As Integer, OutputType As Integer)
' Sub to recursively obtain window handles, classes and text
' given a parent window to search
' Written by Mark Rowlinson
' www.markrowlinson.co.uk - The Programming Emporium
' http://www.vbaexpress.com/kb/getarticle.php?kb_id=52#instr

Dim hWnd As Long, lngRet As Long, y As Integer
Dim strText As String

hWnd = FindWindowEx(hParent, 0&, vbNullString, vbNullString)
While hWnd <> 0
With ActiveSheet
Select Case OutputType
Case winOutputType.winClass
strText = String$(100, Chr$(0))
lngRet = GetClassName(hWnd, strText, 100)
.Range("a1").Offset(cnt, intOffset) = Left$(strText, lngRet)
Case winOutputType.winHandle
.Range("a1").Offset(cnt, intOffset) = hWnd
Case winOutputType.winTitle
strText = String$(100, Chr$(0))
lngRet = GetWindowText(hWnd, strText, 100)
If lngRet > 0 Then
.Range("a1").Offset(cnt, intOffset) = Left$(strText, lngRet)
Else
.Range("a1").Offset(cnt, intOffset) = "N/A"
End If
Case winOutputType.winHandleClass
.Range("a1").Offset(cnt, intOffset) = hWnd
strText = String$(100, Chr$(0))
lngRet = GetClassName(hWnd, strText, 100)
.Range("a1").Offset(cnt, intOffset + 1) = Left$(strText, lngRet)
Case winOutputType.winHandleTitle
.Range("a1").Offset(cnt, intOffset) = hWnd
strText = String$(100, Chr$(0))
lngRet = GetWindowText(hWnd, strText, 100)
If lngRet > 0 Then
.Range("a1").Offset(cnt, intOffset + 1) = Left$(strText, lngRet)
Else
.Range("a1").Offset(cnt, intOffset + 1) = "N/A"
End If
Case winOutputType.winHandleClassTitle
.Range("a1").Offset(cnt, intOffset) = hWnd
strText = String$(100, Chr$(0))
lngRet = GetClassName(hWnd, strText, 100)
.Range("a1").Offset(cnt, intOffset + 1) = Left$(strText, lngRet)
strText = String$(100, Chr$(0))
lngRet = GetWindowText(hWnd, strText, 100)
If lngRet > 0 Then
.Range("a1").Offset(cnt, intOffset + 2) = Left$(strText, lngRet)
Else
.Range("a1").Offset(cnt, intOffset + 2) = "N/A"
End If
End Select
End With

' check for children
y = cnt
Select Case OutputType
Case Is > 4: GetWinInfo hWnd, intOffset + 3, OutputType
Case Is > 2: GetWinInfo hWnd, intOffset + 2, OutputType
Case Else: GetWinInfo hWnd, intOffset + 1, OutputType
End Select

' increment by 1 row if no children found
If y = cnt Then cnt = cnt + 1

' now get next window
hWnd = FindWindowEx(hParent, hWnd, vbNullString, vbNullString)
Wend
End Sub


One more piece of code is needed, that is to get the handle from a partial caption, so knowing some part of the caption, you can get the handle:

Option Explicit

#If VBA7 Then
Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As LongPtr
Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal wCmd As LongPtr) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPtr
#Else
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
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 GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd 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
#End If

' Used a user defined type here rather than Enum so that it works on 97
Private Type winEnum
winHandle As Integer
winClass As Integer
winTitle As Integer
winHandleClass As Integer
winHandleTitle As Integer
winHandleClassTitle As Integer
End Type
Dim winOutputType As winEnum

Private Const GW_HWNDNEXT As Long = 2
' { WM_*: Window messsages
Public Const WM_CHAR = &H102
Public Const WM_CLOSE = &H10
Public Const Wm_CREATE = &H1
Public Const WM_DESTROY = &H2
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_PAINT = &HF
Public Const WM_SETTEXT = &HC
Public Const WM_SETTINGCHANGE = &H1A
Public Const WM_SIZE = &H5
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
' }

Private sCaption As String

#If VBA7 Then
Dim lhWnd As LongPtr
#Else
Dim lhWnd As Long
#End If

#If VBA7 Then
Private Function GetHandleFromPartialCaption(ByRef hWnd As LongPtr, ByRef PartialCaption As String) As Boolean
#Else
Private Function GetHandleFromPartialCaption(ByRef hWnd As Long, ByRef PartialCaption As String) As Boolean
#End If
Dim sStr As String

GetHandleFromPartialCaption = False
lhWnd = FindWindow(vbNullString, vbNullString) 'PARENT WINDOW
Do While lhWnd <> 0
sStr = String(GetWindowTextLength(lhWnd) + 1, Chr$(0))
GetWindowText lhWnd, sStr, Len(sStr)
sStr = Left$(sStr, Len(sStr) - 1)
If InStr(1, sStr, PartialCaption) > 0 Then
PartialCaption = sStr
GetHandleFromPartialCaption = True
hWnd = lhWnd
Exit Do
End If
lhWnd = GetWindow(lhWnd, GW_HWNDNEXT)
Loop
End Function



There is some code and links below, that came from MyEngineeringWorld blog, where Christos Samaras further shows how to interact with a child window once located, that is the reason that to be posted here:
  '-------------
' some samples on how to use the hWnd and ClassName from the above code combined with "SendMessage/PostMessage" so no need for "SendKeys":
' https://myengineeringworld.net/2018/04/open-password-protected-pdf-vba.html
' https://myengineeringworld.net/2013/04/open-pdf-file-with-vba.html
' https://myengineeringworld.net/2013/04/save-web-pages-as-pdf-files.html

Private Sub OpenLockedPdf(pdfPath As String, password As String)
'------------------------------------------------------------------------
'Opens a password-protected PDF file, given its (known) password.
'API functions are used to find the pop-up window and fill the password.
'
'The subroutine can be used in every Office application, as well as
'in AutoCAD. It works for both 32 and 64 bit applications.

'The macro also works with PDF files that are NOT password-protected.
'In that case, the code after the line of ShellExecute is ignored.

'Written By: Christos Samaras
'Date: 30/04/2018
'E-mail: xristos.samaras@gmail.com
'Site: http://www.myengineeringworld.net
'------------------------------------------------------------------------

' Declaring the necessary variables (different for 32 or 64 bit applications).
#If VBA7 And Win64 Then
Dim parentWindow As LongPtr
Dim firstChildWindow As LongPtr
Dim secondChildFirstWindow As LongPtr
#Else
Dim parentWindow As Long
Dim firstChildWindow As Long
Dim secondChildFirstWindow As Long
#End If
Dim timeCount As Date

' Check if the PDF file exists.
If FileExists(pdfPath) = False Then
MsgBox "The PDF file doesn't exist!", vbCritical, "Error in PDF path"
Exit Sub
End If

'The ShellExecute API will try to open the PDF file using the default application that
'is associated with PDF files (either Adobe Reader or Professional).
ShellExecute Application.hWnd, "Open", pdfPath, vbNullString, "C:\", SW_SHOWNORMAL

'Note: The code below will be ignored if the PDF file has no protection.

'Find the handle of the pop-up window.
timeCount = Now()
Do Until Now() > timeCount + TimeValue("00:00:05")
parentWindow = 0
DoEvents
parentWindow = FindWindow("#32770", "Password")
If parentWindow <> 0 Then Exit Do
Loop

If parentWindow <> 0 Then
'Find the handle of the first child window (it is a group box).
timeCount = Now()
Do Until Now() > timeCount + TimeValue("00:00:05")
firstChildWindow = 0
DoEvents
firstChildWindow = FindWindowEx(parentWindow, ByVal 0&, "GroupBox", vbNullString)
If firstChildWindow <> 0 Then Exit Do
Loop

'Find the handle of the subsequent child window (it is the text box for filling the password).
If firstChildWindow <> 0 Then
timeCount = Now()
Do Until Now() > timeCount + TimeValue("00:00:05")
secondChildFirstWindow = 0
DoEvents
secondChildFirstWindow = FindWindowEx(firstChildWindow, ByVal 0&, "RICHEDIT50W", vbNullString)
If secondChildFirstWindow <> 0 Then Exit Do
Loop

'The handle was found, so...
If secondChildFirstWindow <> 0 Then
'Fill the password in the text box.
SendMessage secondChildFirstWindow, WM_SETTEXT, 0&, ByVal password

'Press the OK button (it is the default action, so no need to find the handle of the button).
PostMessage secondChildFirstWindow, WM_KEYDOWN, VK_RETURN, 0
End If
End If
End If
End Sub

Function FileExists(FilePath As String) As Boolean
'Checks if a file exists (using the Dir function... better use File System Object, or store CurDir)
Dim oldCurDir As String

On Error Resume Next
'oldCurDir = VBA.CurDir$() ' store configuration...
If Len(FilePath) > 0 Then
If Not VBA.Dir(FilePath, vbDirectory) = vbNullString Then FileExists = True
End If
'ChDir (oldCurDir) ' restore configuration...
On Error GoTo 0
End Function