Related
So I have some macros run inside an Excel document and wanted to know if there is a way to frequently output text to a Console window (Basicly using it like the immediate window).
I know there are multiple ways of writing text to files, I just want to display some info on the running process without using the immediate window or other windows inside Excel itself.
Using this helps me to display a single line, but I dont want to open a new window for every line:
Call Shell("cmd.exe /K echo testInfo", vbNormalFocus)
I do NOT want to run a command (except echo maybe?) to execute a task, its just supposed to display text.
Thank you in advance for any advice.
EDIT:
As an addition to #JohnRC 's post I found a solution without external applications:
Call Shell("PowerShell.exe -noexit -command get-content " + strPath + " -wait")
Logging information to a textfile at the location after running the command above does the trick.
OK, as I got a couple of downvotes on my earlier answer, I thought I should attempt to provide an actual answer to the request, namely to provide a way of sending log messages to a command prompt window. Here goes...
This solution is implemented as a VBA class that will send messages as comment lines to a separately-running command prompt window that has the text "ExcelLog" in the title. This command prompt must be started separately. The easiest way to do this is to create a shortcut named "ExcelLog" to just run CMD, then when this shortcut is opened the command prompt window will have "ExcelLog" in the title.
Inside the spreadsheet add the code for the class cConsole (below), and then in your VBA code create a global instance of the class and use the method .W "message" to send a text message to the console as a comment line (in this case using the prefix :: to the line to identify it as a comment).
The cConsole class looks for any command prompt window with the requisite title, then sends the comment message to that window. If the window cannot be found, it simply skips the action so the Excel VBA code continues to execute without reporting an error. Also if you open the command prompt window after Excel VBA has started running, cConsole will automatically connect to the window and start/resume sending messages. This means you can close and reopen the command prompt ExcelLog window any time without interrupting the execution of the VBA code.
This seems to work on my setup OK. I think it is a bit more trouble than simply tailing a text file, but - hey, you pays your money and takes your choice.
Here is the code of the cConsole class.
Option Explicit
'// cConsole class
'// This class wraps an interface to a separately-started command prompt
'// window to which messages are sent as comments, so that the command prompt
'// window can be used as a real-time scrolling log from Excel.
'// Each instance of this class creates its own connection to the
'// command prompt window which must have a title containing the text
'// "ExcelLog". If such a window is not open then messages are not
'// logged. The command prompt window can be opened after messages
'// have started, and it will be connected when the next message is
'// sent.
'// The simplest way to set up the necessary command prompt window is to
'// create a shortcut on the desktop the name "ExcelLog" which runs CMD
'// Usage - - - - - - - - - - - -
'//
'// Dim oConsole As New cConsole
'// :
'// oConsole.W "Message to be written to the console"
'//
'// Windows functions to get window handles etc
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 SetForegroundWindow Lib "user32" _
(ByVal hWnd As Long) As Long
'// Handle of the excel log window
Private hLogWindow As Long
Private Sub Class_Initialize()
'// On instantiation, attempts to find the ExcelLog window
findExcelLogWindow
End Sub
Public Sub W(sMsg As String)
'// Public function used to send the given message
'// as a comment line to the linked window
SendToConsole ":: " & sMsg
End Sub
Private Sub SendToConsole(Command As String)
'// Connects to and sends a command line to the command prompt
'// window that is being used as the log
Dim res As Boolean
'// Check that a connection has been made and
'// attempt to connect if not
If hLogWindow = 0 Then
findExcelLogWindow
If hLogWindow = 0 Then Exit Sub
End If
On Error Resume Next
Do
'// Attempt to bring the logging window to the foreground
res = SetForegroundWindow(hLogWindow)
'// Check if successful, and send the command if so
If res Then
SendKeys Command & vbCrLf
Exit Do
Else
'// Not successful, so try reconnecting to the logging window
findExcelLogWindow
'// If we cannot connect, just exit without sending anything
If hLogWindow = 0 Then Exit Sub
End If
Loop
'// Check if there has been any error
If Err.Number <> 0 Then
hLogWindow = 0
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
End If
On Error GoTo 0
End Sub
Private Function findExcelLogWindow() As Long
'// This function looks for a command prompt window that has the text
'// ExcelLog in the title
Dim nLen As Long
Dim sData As String
Dim Class As String
Dim Title As String
'// Get handle to the first window
hLogWindow = 0
'// Check each window in turn
Do
hLogWindow = FindWindowEx(0&, hLogWindow, vbNullString, vbNullString)
'// Check that a window was found
If hLogWindow = 0 Then Exit Do
'// Get the class name of the window
sData = String$(100, Chr$(0))
nLen = GetClassName(hLogWindow, sData, 100)
Class = Left$(sData, nLen)
'// Get the title of the window
sData = String$(100, Chr$(0))
nLen = GetWindowText(hLogWindow, sData, 100)
Title = Left$(sData, nLen)
'// Check if the required window has been found
If Class = "ConsoleWindowClass" And InStr(Title, "ExcelLog") > 0 Then
'// Initialise the window to remove any prompt text
SendToConsole "PROMPT $S"
'// Write some initial messages
Me.W "*******************"
Me.W "[" & ThisWorkbook.Name & "] connected to console at " & Now
Me.W ""
'// Return the handle to the log window
findExcelLogWindow = hLogWindow
Exit Function
End If
Loop
'// The log window was not found, so return zero
findExcelLogWindow = 0
End Function
I tested this out by handling MouseMove events on an image control in a worksheet:
Option Explicit
Private oCons As New cConsole
Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
oCons.W "MouseMove " & X & ", " & Y
End Sub
And here is the result
Instead of using a shell to act as a console to log messages, I have used a text file to hold the log, and monitored the output to the file with a tail utility (I have used WinTail from http://www.baremetalsoft.com/wintail/ but I am sure there are others). This is the code, which I put in a separate vba module named Log. Then call Log.W "Message" to log a message.
Option Explicit
'// You need a reference to "Microsoft Scripting Runtime" library in VBA
Private oLog As Scripting.TextStream
Private bErr As Boolean
Private Sub INIT()
'// Initialise the output log file
'// Check if log file is already open, or there has been an error
If bErr Then Exit Sub
If Not oLog Is Nothing Then Exit Sub
'// Open the log file for appending
Dim ofso As New Scripting.FileSystemObject
On Error Resume Next
Set oLog = ofso.OpenTextFile("excel.log", ForAppending, True)
'// Check that open was successful
If Err.Number <> 0 Then
MsgBox "Log file error: " & Err.Number & ": " & Err.Description
bErr = True
Exit Sub
End If
On Error GoTo 0
'// Write a starting block to the log
oLog.WriteLine "*"
W "********************************** START"
W "* Start of log " & Format(Date, "YYYY-MM-dd")
W ""
End Sub
Public Sub W(sMsg)
'// Writes a single line message to the log
'// Initialize if required
INIT
'// Check for log file error
If bErr Then Exit Sub
'// Create the log line and write to log file
Dim st As String
st = Format(Now, "hh:mm:ss ")
oLog.WriteLine st & sMsg
End Sub
Public Function ReportErr(Optional Loc As Variant = "") As Boolean
'// Reports information from the Err object, if an error has occured
'// Check if error has occurred, exit if not
If Err.Number = 0 Then ReportErr = False: Exit Function
'// Set return value
ReportErr = True
'// Initialize if required
INIT
'// Check for log file error
If bErr Then Exit Function
'// Write the error block to the log
W "*********** ERROR ******* " & IIf(Len(Loc) > 0, "[" & Loc & "]", "")
W "* Error #" & Err.Number
If Len(Err.Description) > 0 Then
W "* : " & Err.Description
W "*************************"
End If
End Function
Tailing the log file with WinTail means that output to the log appears immediately it is written, so you can monitor the log as the program is running.
Is it possible to rename the activedocument (the word document that I'm running the macro from) with VBA?
Right now I'm saving my activedocument under a new name and then attempt to delete the original. The latter part won't go through, so the original never gets deleted.
Anyone know if this is even possible?
I spent a lot of time doing this recently, because I disliked having to delete previous files when I did "Save As" - I wanted a "Save as and delete old file" answer. My answer is copied from here.
I added it to the quicklaunch bar which works wonderfully.
Insert following code into normal.dotm template (found in C:\Documents and Settings\user name\Application Data\Microsoft\Templates for Windows 7 for Word)
Save normal.dotm
Add this to the quicklaunch toolbar in Word.
Optional - remap a keyboard shortcut to this
Optional - digitally sign your template (recommended)
Note this actually moves the old file to the Recycle Bin rather than trashing completely and also sets the new file name in a very convenient fashion.
Option Explicit
'To send a file to the recycle bin, we'll need to use the Win32 API
'We'll be using the SHFileOperation function which uses a 'struct'
'as an argument. That struct is defined here:
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As Long
End Type
' function declaration:
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
'there are some constants to declare too
Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_SILENT = &H4
Function RecycleFile(FileName As String, Optional UserConfirm As Boolean = True, Optional HideErrors As Boolean = False) As Long
'This function takes one mandatory argument (the file to be recycled) and two
'optional arguments: UserConfirm is used to determine if the "Are you sure..." dialog
'should be displayed before deleting the file and HideErrors is used to determine
'if any errors should be shown to the user
Dim ptFileOp As SHFILEOPSTRUCT
'We have declared FileOp as a SHFILEOPSTRUCT above, now to fill it:
With ptFileOp
.wFunc = FO_DELETE
.pFrom = FileName
.fFlags = FOF_ALLOWUNDO
If Not UserConfirm Then .fFlags = .fFlags + FOF_NOCONFIRMATION
If HideErrors Then .fFlags = .fFlags + FOF_SILENT
End With
'Note that the entire struct wasn't populated, so it would be legitimate to change it's
'declaration above and remove the unused elements. The reason we don't do that is that the
'struct is used in many operations, some of which may utilise those elements
'Now invoke the function and return the long from the call as the result of this function
RecycleFile = SHFileOperation(ptFileOp)
End Function
Sub renameAndDelete()
' Store original name
Dim sOriginalName As String
sOriginalName = ActiveDocument.FullName
' Save As
Dim sFilename As String, fDialog As FileDialog, ret As Long
Set fDialog = Application.FileDialog(msoFileDialogSaveAs)
'set initial name so you don't have to navigate to
fDialog.InitialFileName = sOriginalName
ret = fDialog.Show
If ret <> 0 Then
sFilename = fDialog.SelectedItems(1)
Else
Exit Sub
End If
Set fDialog = Nothing
'only do this if the file names are different...
If (sFilename <> sOriginalName) Then
'I love vba's pretty code
ActiveDocument.SaveAs2 FileName:=sFilename, FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False, CompatibilityMode:=14
' Delete original (don't care about errors, I guess)
Dim hatersGonnaHate As Integer
hatersGonnaHate = RecycleFile(sOriginalName, False, True)
End If
End Sub
I am currently using the following code to run a dos command as follows from VBA.
Set objShell = CreateObject("WScript.Shell")
dos_command="\\\10.xx.xx.xx\test\7z.exe a -r " etc etc etc
result = objShell.Run(dos_command, 0, True)
Set objShell =nothing
All runs well, the only problem is that I get an annoying Warning Windows Box advising a program is trying to run in my computer, press OK or Cancel
I must use "objshell" because I need VBA to wait until DOS command is completed.
is there a way to avoid the warning box from coming up from within VBA or adding some additional parameters to the DOS command ?
The 7z.exe file is running in a server (not local PC) so I assume that's the problem.
I cannot use or install 7z.exe in each machine.
Here are three options, presented in order from quickest/dirtiest to most robust:
Create a text file as part of command line and wait for its existence: modify your command line to something like this and run it using Shell (not your objShell):
dos_command = "\\\10.xx.xx.xx\test\7z.exe a -r " etc etc etc
dos_command = dos_command & " && echo > " & TempFileName
This will create a text file named TempFileName after your 7-zip code completes. You just need to make sure TempFileName does not exist before you run your shell command, then run the command and wait for the TempFileName file to exist.
Use OpenProcess and GetExitCodeProcess APIs: launch your command line using the OpenProcess API call which provides access to your new process (note that the Shell function returns the ProcessID of the launched process). Then use the ProcessID to sit in a loop and poll the process via GetExitCodeProcess. Relevant declarations:
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
lpExitCode As Long) As Long
Private Const STILL_ACTIVE = &H103
Private Const PROCESS_QUERY_INFORMATION = &H400
'---------------------------------------------------------------------------------------vv
' Procedure : ShellWait
' DateTime : 2/15/2008 10:59
' Author : Mike
' Purpose : Executes a shell command and waits for it to complete.
' Notes : Runs the shell as a batch file, allowing the user to pass a string with
' line breaks to execute a multi-line command.
'
' : Provides two means to break out of the loop.
' 1) Provide a timeout in seconds.
' The code breaks out once it reaches the timeout.
' 2) Provide a flag to tell the procedure to stop running.
' To use this option, you would need to pass the procedure a global flag
' that the user has the ability to change through the interface.
' Update (5/23/2008):
' - Uses a progressive sleep timer to allow fast processes to run quickly
' and long processes to get increasing clock cycles to work with.
' - Changed default window mode to hidden.
'---------------------------------------------------------------------------------------
'^^
Public Function ShellWait(DosCmd As String, _
Optional StartIn As String = "WINDOWS TEMP FOLDER", _
Optional WindowStyle As VbAppWinStyle = vbHide, _
Optional TimeOutSeconds As Long = -1, _
Optional ByRef StopWaiting As Boolean = False) 'vv
On Error GoTo Err_ShellWait
Dim hProcess As Long, RetVal As Long, StartTime As Long
Dim BatName As String, FileNum As Integer, SleepTime As Long
StartTime = Timer
BatName = TempFileName(StartIn, "bat")
FileNum = FreeFile()
Open BatName For Output As #FileNum
ChDrive Left(BatName, 1)
ChDir Left(BatName, InStrRev(BatName, "\"))
Print #FileNum, DosCmd
Close #FileNum
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(BatName, WindowStyle))
SleepTime = 10
Do
'Get the status of the process
GetExitCodeProcess hProcess, RetVal
DoEvents: Sleep SleepTime
If TimeOutSeconds <> -1 Then
If Timer - StartTime > TimeOutSeconds Then Exit Do
End If
If StopWaiting Then Exit Do
'Progressively increase the SleepTime by 10%
' This allows a quick process to finish quickly, while providing
' a long process with increasingly greater clock cycles to work with
SleepTime = SleepTime * 1.1
Loop While RetVal = STILL_ACTIVE
Kill BatName
Exit_ShellWait:
Exit Function
Err_ShellWait:
MsgBox Err.Description
Resume Exit_ShellWait
End Function
'---------------------------------------------------------------------------------------vv
' Procedure : TempFileName
' DateTime : 12/9/08
' Author : Mike
' Purpose : Returns an unused file name but does not create the file. Path can be
' passed with or without the trailing '\'.
' Requires : TempPath() function
'---------------------------------------------------------------------------------------
'^^
Function TempFileName(Optional ByVal Path As String = "WINDOWS TEMP FOLDER", _
Optional Ext As String = "txt", _
Optional Prefix As String = "temp") As String 'vv
Dim TempFName As String, i As Integer
If Path = "WINDOWS TEMP FOLDER" Then Path = TempPath
If Right(Path, 1) <> "\" Then Path = Path & "\"
If Not (Path Like "?:\*" Or Path Like "\\*") Then
Err.Raise 52 '"Bad file name or number."
ElseIf Dir(Path, vbDirectory) = "" Then
Err.Raise 76 '"Path not found."
End If
TempFName = Path & Prefix & "." & Ext
For i = 1 To 500
If Dir(TempFName) = "" Then
TempFileName = TempFName
GoTo Exit_TempFileName
End If
TempFName = Path & Prefix & "_" & Format(i, "000") & "." & Ext
Next i
TempFileName = ""
End Function
'---------------------------------------------------------------------------------------
' Procedure : TempPath
' Author : Mike
' Date : 8/12/2008
' Purpose : Returns something like:
' C:\DOCUME~1\BGRAND~1\LOCALS~1\Temp\
'---------------------------------------------------------------------------------------
'^^
Function TempPath() As String 'vv
Const TemporaryFolder = 2
Static TempFolderPath As String
Dim fs As Object
If Len(TempFolderPath) = 0 Then
Set fs = CreateObject("Scripting.FileSystemObject")
TempFolderPath = fs.GetSpecialFolder(TemporaryFolder) & "\"
End If
TempPath = TempFolderPath
End Function
Use CreateProcess and WaitForSingleObject APIs: refer to the "Super Shell" example at this help page for CreateProcess
Calling Microsoft® Windows® Script Host causes windows to display the message. Instead try this
Public Sub test()
Dim dos_command$, lRet&
dos_command = """\\xxx.xxx.xxx.xxx\xxx\xxx\7z.exe"" a test.zip ""\\xxx.xxx.xxx.xxx\xxx\xxx\*.log"" -r"
lRet = Shell(dos_command, vbMaximizedFocus)
MsgBox lRet
End Sub
UPDATE
You may do the following and use your code:
Open Start | Run and type gpedit.msc. Click OK
User Configuration >> Administrative Templates >> Windows Components >> Attachment Manager
Add 7z.exe to the Inclusion list for moderate risk file types setting.
Hpe this helps
The problem
I have a word template which uses VBA's Declare statement to link to a dll, whose path can be determined within the VBA macro
I want to delploy this to the users %APPDATA%\Microsoft\Word\STARTUP directory
I DON'T want to permanently change the user's PATH environment variable (temporarily would be OK, but this doesn't seem to work as they don't get refreshed until application restart)
Attempted solution
I tried dynamically adding the code with the Declare statements using ThisDocument.VBProject.CodeModule.AddFromString(code) which works when loading the template from a normal directory, but when the template is within Word\STARTUP, it gives the following error:
Run-time error '50289':
Can't perform operation since the
project is protected.
And setting the registry key "HKEY___LOCAL_MACHINE\Software\Microsoft\Office\11.0\Word\Security\AccessVBOM" to 1 doesn't fix this when the template is in Word\STARTUP
I'm really struggling to find a solution. If anyone knows a way to do this, that would be great.
Frankly, I don't know what's the problem with using all those VBA code injection, assembly generation for LoadLibrary() calls, etc techniques that I've seen used for this simple task. In my project I use simple code to load dll from the same location as the workbook, like this:
Declare Function MyFunc Lib "MyDll.dll" (....) As ...
Sub Test()
....
ChDir ActiveWorkbook.Path
... = MyFunc(....)
End Sub
Excel 2003 at least, has no problem loading the dll from the current path, Set ChDir to whatever path your DLL has. You might also need to change your current drive which is separate from current path. You have to do it only once, before the first function call, after it the DLL stays attached no matter where your current path is, so you may do it once in workbook_open and not bother about the path later. I provide an empty dummy function in the DLL just for this pupose. I don't think MS Word is any different on this.
Private Declare Sub Dummy Lib "MyDLL.dll" ()
Private Sub Workbook_Open()
ChDrive Left$(Me.Path, 1)
ChDir Me.Path
Dummy
End Sub
You can use LoadLibrary api.
For example in my projects the code looks like this:
If LibraryLoaded() Then
Call MyFunc ...
End If
Public Function LibraryLoaded() As Boolean
Static IsLoaded As Boolean
Static TriedToLoadAlready As Boolean
If TriedToLoadAlready Then
LibraryLoaded = IsLoaded
Exit Function
End If
Dim path As String
path = VBAProject.ThisWorkbook.path
path = Left(path, InStrRev(path, "\") - 1)
IsLoaded = LoadLibrary(path & "\bin\" & cLibraryName)
TriedToLoadAlready = True
LibraryLoaded = IsLoaded
End Function
There is another really really ugly solution, but this blogger figured it out, and I can't figure out any other way:
http://blogs.msdn.com/pranavwagh/archive/2006/08/30/How-To-Load-Win32-dlls-Dynamically-In-VBA.aspx
Basically, you write a procedure that creates a code module in VBA during runtime. This module must create a reference to the dll and it must create a dummy function (or procedure) as part of this module that calls the dll. Then, from your code, you use Application.Run(dummyfunction(), arg1, arg2...). This is necessary because otherwise, the project will not compile because dummyfunction isn't yet a function.
You'll notice in his code, he uses InputBox() to get the location of the .dll but obviously you could get the location from a range in the spreadsheet. The following code snippet may be useful.
Dim cm As CodeModule
Dim vbc As VBComponent
Set cm = Application.VBE.ActiveVBProject.VBComponents.Add(vbext_ct_StdModule).CodeModule
cm.AddFromString (decString & funcString)
cm.Name = "MyNewModule"
Set vbc = cm.Parent
Application.VBE.ActiveVBProject.VBComponents.Remove vbc
'decString' and 'funcString' were just strings I constructed like his 'ss'. The snippet shows how you can rename the code module so that you could delete it later if needed. Obviously, this just deletes it right after it is created, and you probably wouldn't want to do that, but at least it shows you how it would be done.
Having said all that, we mostly just write .exe's now and shell out. If you need VBA to wait on the shell to finish, there are solutions for that issue as well.
Here's what I ended up doing, using Pranav Wagh's methodology linked above and code from C Pearson's site (http://www.cpearson.com/excel/vbe.aspx). This code prompts the user to select the path to the dll using an Open File window, builds a new module with a Declare Function with the inputted path and a function to execute a handshake with the dll. The purpose-built function in the dll returns a 1 if successful:
Public rtn As Integer
Sub LinkToDll()
Dim path As String, default As String
MsgBox "Select Geo_DLL.dll file from next window"
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Title = "Select Geo_DLL.dll file"
If .Show = True Then
path = .SelectedItems(1)
End If
End With
'Add a module
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
VBComp.Name = "LinkModule"
'Add procedure to module
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Set VBComp = VBProj.VBComponents("LinkModule")
Set CodeMod = VBComp.CodeModule
With CodeMod
LineNum = .CountOfLines + 1
.InsertLines LineNum, "Declare Function RegDll Lib " & Chr(34) & path & Chr(34) & " (ByRef rtn As Integer)"
LineNum = LineNum + 1
.InsertLines LineNum, "Sub runthisfunc(rtn)"
LineNum = LineNum + 1
.InsertLines LineNum, "On Error Resume Next"
LineNum = LineNum + 1
.InsertLines LineNum, "rtn = 0"
LineNum = LineNum + 1
.InsertLines LineNum, "RegDll rtn"
LineNum = LineNum + 1
.InsertLines LineNum, "If rtn = 1 Then MsgBox (" & Chr(34) & "DLL linked" & Chr(34) & ")"
LineNum = LineNum + 1
.InsertLines LineNum, "If rtn = 0 Then MsgBox (" & Chr(34) & "DLL not found" & Chr(34) & ")"
LineNum = LineNum + 1
.InsertLines LineNum, "End Sub"
End With
'This is what CodeMod.InsertLines is writing:
'--------------------------------------------
'Declare Function RegDll Lib "C:\path\Geo_DLL.dll" (ByRef rtn As Integer)
'Sub runthisfunc(rtn)
'On Error Resume Next
'rtn = 0
'RegDll rtn
'If rtn = 1 Then MsgBox ("DLL Linked")
'If rtn = 0 Then MsgBox (DLL not found")
'End Sub
Application.Run "runthisfunc", rtn
'Delete Module
VBProj.VBComponents.Remove VBComp
End Sub
However, once I turned the workbook (xlsm) into an addin (xlam) I found that Excel wouldn't let the macro create new modules so my LinkToDll wouldn't work. The fix was to put the Declare Function back into LinkToDll with just the dll file name ("Geo_DLL.dll") as the Lib along with the runthisfunc sub. I found having the user simply select the dll file via the Open File window was enough to point Excel to the dll even with only the file name in the Lib portion of the Declare Function statement.
Chris
In my case code below worked. I added "ChDir (ThisWorkbook.Path)"
after function. But I tested it only on my laptop. I don't know if it works on network.
Option Explicit
' Declare the function that is in the DLL
Private Declare PtrSafe Function suntransitForEXL Lib _
"sampadll.dll" (ByRef lat As Double, ByRef lon As Double, ByRef dy As Integer, ByRef mnt As Integer, ByRef yr As Integer, ByRef tmz As Double) As Double
' use function on worksheet
Function noon(latitude As Double, longtitude As Double, day As Integer, month As Integer, year As Integer, timezone As Double) As Double
ChDir (ThisWorkbook.Path) ' Set working directory to current.
Dim decimaltime As Double
Dim hour As Integer
Dim minute As Integer
Dim second As Integer
decimaltime = suntransitForEXL(latitude, longtitude, day, month, year, timezone)
hour = Fix(decimaltime)
minute = Fix((decimaltime - hour) * 60)
second = Fix(((decimaltime - hour) * 60 - minute) * 60)
noon = TimeSerial(hour, minute, second)
End Function
I need help in
figuring out how to iterate through currently open Excel add-in files (.xla) that have not been registered in Excel using the Tools > Add-ins menu path.
more specifically, I am interested in any workbook that doesn't appear in the Add-In dialog, but has ThisWorkbook.IsAddin = True.
Demonstrating the issue:
Trying to loop through workbooks as follows doesn't get workbooks with .AddIn = True:
Dim book As Excel.Workbook
For Each book In Application.Workbooks
Debug.Print book.Name
Next book
Looping through add-ins doesn't get add-ins that are not registered:
Dim addin As Excel.AddIn
For Each addin In Application.AddIns
Debug.Print addin.Name
Next addin
Looping through the VBProjects collection works, but only if user has specifically trusted access to the Visual Basic Project in the Macro Security settings - which is rarely:
Dim vbproj As Object
For Each vbproj In Application.VBE.VBProjects
Debug.Print vbproj.Filename
Next vbproj
However, if the name of the workbook is known, the workbook can be referenced directly regardless of whether it is an add-in or not:
Dim book As Excel.Workbook
Set book = Application.Workbooks("add-in.xla")
But how the heck to get reference to this workbook if the name is not known, and user's macro security settings cannot be relied on?
As of Office 2010, there is a new collection .AddIns2 which is the same as .AddIns but also includes the unregistered .XLA plug-ins.
Dim a As AddIn
Dim w As Workbook
On Error Resume Next
With Application
For Each a In .AddIns2
If LCase(Right(a.name, 4)) = ".xla" Then
Set w = Nothing
Set w = .Workbooks(a.name)
If w Is Nothing Then
Set w = .Workbooks.Open(a.FullName)
End If
End If
Next
End With
I have had issues with addins that are installed (and in the VBE) not being available via user's Addin on Exel 2013 (in a work environment).
Tinkering with the solution from Chris C gave a good workaround.
Dim a As AddIn
Dim wb As Workbook
On Error Resume Next
With Application
.DisplayAlerts = False
For Each a In .AddIns2
Debug.Print a.Name, a.Installed
If LCase(Right$(a.Name, 4)) = ".xla" Or LCase(Right$(a.Name, 5)) Like ".xla*" Then
Set wb = Nothing
Set wb = .Workbooks(a.Name)
wb.Close False
Set wb = .Workbooks.Open(a.FullName)
End If
Next
.DisplayAlerts = True
End With
I'm still on the lookout for a sane solution for this problem, but for the time being it seems that reading the window texts of all workbook windows gives a collection of all open workbooks, add-in or not:
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
Public Function GetAllOpenWorkbooks() As Collection
'Retrieves a collection of all open workbooks and add-ins.
Const EXCEL_APPLICATION_WINDOW As String = "XLDESK"
Const EXCEL_WORKBOOK_WINDOW As String = "EXCEL7"
Dim hWnd As Long
Dim hWndExcel As Long
Dim contentLength As Long
Dim buffer As String
Dim bookName As String
Dim books As Collection
Set books = New Collection
'Find the main Excel window
hWndExcel = FindWindowEx(Application.hWnd, 0&, EXCEL_APPLICATION_WINDOW, vbNullString)
Do
'Find next window
hWnd = FindWindowEx(hWndExcel, hWnd, vbNullString, vbNullString)
If hWnd Then
'Create a string buffer for 100 chars
buffer = String$(100, Chr$(0))
'Get the window class name
contentLength = GetClassName(hWnd, buffer, 100)
'If the window found is a workbook window
If Left$(buffer, contentLength) = EXCEL_WORKBOOK_WINDOW Then
'Recreate the buffer
buffer = String$(100, Chr$(0))
'Get the window text
contentLength = GetWindowText(hWnd, buffer, 100)
'If the window text was returned, get the workbook and add it to the collection
If contentLength Then
bookName = Left$(buffer, contentLength)
books.Add Excel.Application.Workbooks(bookName), bookName
End If
End If
End If
Loop While hWnd
'Return the collection
Set GetAllOpenWorkbooks = books
End Function
What about this:
Public Sub ListAddins()
Dim ai As AddIn
For Each ai In Application.AddIns
If Not ai.Installed Then
Debug.Print ai.Application, ai.Parent, ai.Name, ai.FullName
End If
Next
End Sub
Any use?
Use =DOCUMENTS, an Excel4 macro function.
Dim Docs As Variant
Docs = Application.Evaluate("documents(2)")
Here's the documentation for it (available here):
DOCUMENTS
Returns, as a horizontal array in text form, the names of the specified open workbooks in alphabetic order. Use DOCUMENTS to retrieve the names of open workbooks to use in other functions that manipulate open workbooks.
Syntax
DOCUMENTS(type_num, match_text)
Type_num is a number specifying whether to include add-in workbooks in the array of workbooks, according to the following table.
Type_num Returns
1 or omitted Names of all open workbooks except add-in workbooks
2 Names of add-in workbooks only
3 Names of all open workbooks
Match_text specifies the workbooks whose names you want returned and can include wildcard characters. If match_text is omitted, DOCUMENTS returns the names of all open workbooks.
Is iterating through the registry a possibility? I know that that doesn't give you a snapshot of what your instance of Excel is using, but what a new instance would use - but depending on what you need it for, it might be good enough.
The relevant keys are:
'Active add-ins are in values called OPEN*
HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\Options
'Inactive add-ins are in values of their full path
HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\Add-in Manager