Monday, October 9, 2017

using named ranges in macros

assign the value of the named range to a variable, thus:

dim abc as string

abc = sheets("Sheet 1").range("Account").value

where Account is a named range in Sheet 1

Saturday, June 17, 2017

Tuesday, June 13, 2017

Extract File List from Folder

Sub ListFiles2()
Dim fileList() As String
Dim fName As String
Dim fPath As String
Dim i As Integer
Dim startrow As Integer
Dim ws As Worksheet
Dim filetype  As String

'=======================================================
fPath = "C:\Temp\"
filetype = "*"
Set ws = Worksheets("Sheet2")
startrow = 2    'starting row for the data
'========================================================

fName = Dir(fPath & "*." & filetype)
While fName <> ""
    i = i + 1
    ReDim Preserve fileList(1 To i)
    fileList(i) = fName
    fName = Dir()
Wend
If i = 0 Then
    MsgBox "No files found"
    Exit Sub
End If
    
For i = 1 To UBound(fileList)
    ws.Range("A" & i + startrow).Value = fileList(i)
Next
Columns(1).AutoFit

End Sub

Monday, June 12, 2017

Extracting filenames within a given zip file

Sub ListZipDetails()
  Dim R As Long, PathFilename As Variant, FileNameInZip As Variant, oApp As Object
  PathFilename = Application.GetOpenFilename("ZipFiles (*.zip), *.zip")
  If PathFilename = "False" Then Exit Sub
  R = Cells(Rows.Count, "A").End(xlUp).Row
  Set oApp = CreateObject("Shell.Application")
  For Each FileNameInZip In oApp.Namespace(PathFilename).Items
    R = R + 1
    Cells(R, "A").Value = FileNameInZip & "  (" & PathFilename & ")"
  Next
  Set oApp = Nothing
End Sub
NOTE: As written, this code will not iterate through folders inside of the zip.

Saturday, June 10, 2017

Be careful! Parts of your document may include personal information that can't be removed by the Document Inspector

Goto File in the upper left hand corner, then Options > Trust Center > Trust Center Settings > Privacy Options > then un-check the check box that says "Remove personal information from file properties on save", then hit OK.

Sunday, June 4, 2017

AppActivate

https://msdn.microsoft.com/en-us/library/office/gg278643.aspx

Best Practices

Avoid use Excel's built-ins: ActiveWorkbook, ActiveSheet, and Selection: capture return values, and, favor qualified expressions instead.
Use the built-ins only once and only in outermost macros(subs) and capture at macro start, e.g.
Set wkb = ActiveWorkbook
Set wks = ActiveSheet
Set sel = Selection
During and within macros do not rely on these built-in names, instead capture return values, e.g.
Set wkb = Workbooks.Add 'instead of Workbooks.Add without return value capture
wkb.Activate 'instead of Activeworkbook.Activate
Also, try to use qualified expressions, e.g.
wkb.Sheets("Sheet3").Name = "foo" ' instead of Sheets("Sheet3").Name = "foo"
or
Set newWks = wkb.Sheets.Add
newWks.Name = "bar" 'instead of ActiveSheet.Name = "bar"
Use qualified expressions, e.g.
newWks.Name = "bar" 'instead of `xyz.Select` followed by Selection.Name = "bar" 
These methods will work better in general, give less confusing results, will be more robust when refactoring (e.g. moving lines of code around within and between methods) and, will work better across versions of Excel. Selection, for example, changes differently during macro execution from one version of Excel to another.
Also please note that you'll likely find that you don't need to .Activate nearly as much when using more qualified expressions. (This can mean the for the user the screen will flicker less.) Thus the whole line Windows(expression).Activate could simply be eliminated instead of even being replaced by wkb.Activate.
(Also note: Many .Select statements do not contribute anything and can be omitted.)
(I think that Excel's macro recorder is responsible for promoting this more fragile style of programming using ActiveSheet, ActiveWorkbook, Selection, and Select so much; this style leaves a lot of room for improvement.)

toggle between apps with powershell

Use single quotes in your SendWait calls. I.e.: SendWait('%{TAB}%{TAB}') 

So I think I figured it out. You don't want to do an ALT + TAB for the toggle since this is a Z-Based swap. This means it only toggles between the first and second applications running. However, if you do Alt+Shift+ESC, this will tell the system to pull the last item in the list and bring it forward
I figured it out.
Use SendWait("%{TAB}")
In powershell the only way to use the alt key seems to be with the % symbol.

Saturday, June 3, 2017

Cycle through open Windows applications

VBScript in WHS was the way to go.



'****************************************************************************************
' Script Name: ApplicationCycler.vbs
'      Author: Ian Burns
'        Date: 2 Dec 2011
'   Edited By: Makaveli84
'   Edit Date: 30 Aug 2014
' Description: VBScript for Windows Scripting Host. Cycles through any applications 
'              visible in the Task Bar giving them focus for a set period.
'       Usage: Save file to Desktop and double click to run. If it isn't already running,
'              it will start. If it is already running, it will stop.
'*****************************************************************************************
Option Explicit

Dim wshShell
Dim wshSystemEnv
Dim intCycle
Dim intSleep
Dim intTimer

' Cycle every 5 seconds / Check on/off status every 250 milliseconds
intCycle = 5000: intSleep = 250: intTimer = intCycle

Set wshShell = CreateObject("WScript.Shell")
' Volatile environment variables are not saved when user logs off
Set wshSystemEnv = wshShell.Environment("VOLATILE")

' Check to see if the script is already running
If len(wshSystemEnv("AlreadyRunning")) = 0 Then

    ' It isn't, so we set an environment variable as a flag to say the script IS running
    wshSystemEnv("AlreadyRunning") = "True"

    ' Now we go into a loop, cycling through all the apps on the task bar
    Do While len(wshSystemEnv("AlreadyRunning")) > 0
        ' Simulate the Alt+Esc keypress
        If intTimer >= intCycle Then
            wshShell.SendKeys "%+{Esc}"
            intTimer = 0
        End If
        intTimer = intTimer + intSleep
        Wscript.Sleep intSleep
    Loop

Else
    ' Delete the environment variable
    wshSystemEnv.Remove("AlreadyRunning")
End If


' Tidy up
Set wshSystemEnv = Nothing
Set wshShell = Nothing

Windows API

http://www.techrepublic.com/blog/10-things/10-plus-of-my-favorite-windows-api-functions-to-use-in-office-applications/

https://msdn.microsoft.com/en-us/library/office/aa165081(v=office.10).aspx


https://docs.microsoft.com/en-us/dotnet/visual-basic/programming-guide/com-interop/walkthrough-calling-windows-apis

https://docs.microsoft.com/en-us/dotnet/visual-basic/programming-guide/com-interop/walkthrough-calling-windows-apis

http://allapi.mentalis.org/vbtutor/api1.shtml


http://vbadud.blogspot.ca/2007/06/show-all-processes-using-vba.html

VBA Tutorial - good beginners primer

http://ritc.rotman.utoronto.ca/documents/2017/RIT%20-%20User%20Guide%20-%20VBA%20API%20Documentation.pdf

how to move and click the mouse using VBA

https://excelhelphq.com/how-to-move-and-click-the-mouse-in-vba/

You could use Excel VBA to move the mouse and click on things (left and right click). Below is an example of moving the mouse to the top left of the screen and then clicking. Just copy the code and paste it into macro window in Excel.

The SingleClick() subroutine is a single click, while DoubleClick() subroutine does a double click. The code is quite self explanatory and needs minimal instructions.
Note that SetCursorPos moves the mouse based on the coordinates supplied. The first parameter is the # of pixels to the right from the top left corner of the monitor (x-axis) and the second parameter is the # of pixels below the top left corner of the monitor (y-axis). If the user is using duel monitors, it will be top left corner of the the left most monitor.

Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Public Const MOUSEEVENTF_RIGHTUP As Long = &H10

Private Sub SingleClick()
  SetCursorPos 100, 100 'x and y position
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub

Private Sub DoubleClick()
  'Double click as a quick series of two clicks
  SetCursorPos 100, 100 'x and y position
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub

Private Sub RightClick()
  'Right click
  SetCursorPos 200, 200 'x and y position
  mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End Sub

Two ways to activate a program with VBA if already open

http://wellsr.com/vba/2015/excel/appactivate-activate-folder-or-application-if-already-open/

How to find a window in three ways

This uses Windows API, so you need to invoke that first, something like:

Private Declare Function showwindow Lib "user32" (ByVal hwnd As Long, ByVal ncmdshow As Long) As Long


First, use AppActivate. If the window does not exist, this raises an error.
' Use AppActivate to see if the window exists.
Private Sub cmdAppActivate_Click()
    On Error Resume Next
    AppActivate txtWindowTitle.Text

    If Err.Number <> 0 Then
        MsgBox "The window does not exist."
    Else
        MsgBox "The window exists."
    End If
End Sub
Second, use the FindWindow API function. FindWindow returns 0 if the window doesn't exist.
' Use FindWindow to see if the window exists.
Private Sub cmdFindWindow_Click()
    If FindWindow(ByVal 0, txtWindowTitle.Text) = 0 Then
        MsgBox "The window does not exist."
    Else
        MsgBox "The window exists."
    End If
End Sub
Finally, use EnumWindows. The window enumerator function uses GetWindowText to get each window's title. If the title matches the target window name, then it has found the target. This is the most complex method but also the most flexible. For example, you could look for a window when you know only part of its title or you could take action on all windows with the same or similar titles.
' Use EnumWindows to see if the window exists.
Private Sub cmdEnumWindows_Click()
    TargetName = txtWindowTitle.Text
    TargetHwnd = 0
    
    ' Examine the window names.
    EnumWindows AddressOf WindowEnumerator, 0

    ' See if we got an hwnd.
    If TargetHwnd = 0 Then
        MsgBox "The window does not exist."
    Else
        MsgBox "The window exists."
    End If
End Sub

' Return False to stop the enumeration.
Public Function WindowEnumerator(ByVal app_hwnd As Long, _
    ByVal lparam As Long) As Long
Dim buf As String * 256
Dim title As String
Dim length As Long

    ' Get the window's title.
    length = GetWindowText(app_hwnd, buf, Len(buf))
    title = Left$(buf, length)

    ' See if the title contains the target.
    If InStr(title, TargetName) > 0 Then
        ' Save the hwnd and end the enumeration.
        TargetHwnd = app_hwnd
        WindowEnumerator = False
    Else
        ' Continue the enumeration.
        WindowEnumerator = True
    End If
End Function

Switching focus from Excel to an Access DB Window

Try this, you'll have to modify to suit. when you want to switch from excel to access, add
appactivate "Microsoft Access"

Private Declare Function showwindow Lib "user32" (ByVal hwnd As Long, ByVal ncmdshow As Long) As Long Private Const sw_shownormal = 4 Private Sub OpenDatabase_Click() Dim results Dim objAccess As Object Dim i As Integer Dim whwnd As Long On Error Resume Next Set objAccess = GetObject(, "access.application") If objAccess Is Nothing Then 'get a reference to the access application object Set objAccess = GetObject("", "access.application") 'open the database objAccess.opencurrentdatabase "C:\GMD\GMD Simulation.mdb" whwnd = Findwindow("Microsoft Excel", vbNullString) showwindow whwnd, sw_shownormal If whwnd = 0 Then AppActivate "GMD Simulation Input" End If End If Set objAccess = Nothing End Sub