I'm looking for a way to clear "Replication History" programmatically (typically we do it manually if needed, see image below)
I have checked LS and Java classes and did not found anything useful.
I will try to find something Notes C API database but I really want to avoid using C API.
Any ideas or suggestion would be very welcome.
Here is a solution (credits go to Richard Schwartz as well for helping with C API function).
(Declarations)
Public Const W32_LIB = {nnotes.dll}
Public Const LINUX_LIB = {libnotes.so}
Declare Function W32_NSFDbOpen Lib W32_LIB Alias {NSFDbOpen} (ByVal dbName As String, hDb As Long) As Integer
Declare Function W32_NSFDbClose Lib W32_LIB Alias {NSFDbClose} (ByVal hDb As Long) As Integer
Declare Function W32_NSFDbClearReplHistory Lib W32_LIB Alias {NSFDbClearReplHistory} (ByVal hDb As Long, flags As Integer) As Integer
Declare Function LINUX_NSFDbOpen Lib LINUX_LIB Alias {NSFDbOpen} (ByVal dbName As String, hDb As Long) As Integer
Declare Function LINUX_NSFDbClose Lib LINUX_LIB Alias {NSFDbClose} (ByVal hDb As Long) As Integer
Declare Function LINUX_NSFDbClearReplHistory Lib LINUX_LIB Alias {NSFDbClearReplHistory} (ByVal hDb As Long, flags As Integer) As Integer
Dim IS_WINDOWS As Boolean
Initialize (figure out platform: windows or linux)
Dim session As NotesSession
Set session = New NotesSession
IS_WINDOWS = InStr(session.Platform, "Windows") <> 0
Clear replication history
Function processDb(server As String, filename As String) As Boolean
On Error GoTo errh
Dim hdb As Long
Dim rc As Integer
If Server = "" Then
If IS_WINDOWS Then
rc = W32_NSFDbOpen(FileName, hDb)
Else
rc = LINUX_NSFDbOpen(FileName, hDb)
End If
Else
If IS_WINDOWS Then
rc = W32_NSFDbOpen(Server & "!!" & FileName, hDb)
Else
rc = LINUX_NSFDbOpen(Server & "!!" & FileName, hDb)
End If
End If
If rc <> 0 Then
Error 9001, "Database " & Server & "!!" & FileName & " - could not be opened"
End If
If IS_WINDOWS Then
rc = W32_NSFDbClearReplHistory(hDb, 0)
Else
rc = LINUX_NSFDbClearReplHistory(hDb, 0)
End If
If rc <> 0 Then
Error 9002, "Database " & Server & "!!" & FileName & " - replication history failed"
End If
If IS_WINDOWS Then
rc = W32_NSFDbClose(hDb)
Else
rc = LINUX_NSFDbClose(hDb)
End If
processDb = true
final:
Exit Function
errh:
MsgBox "!! " & Error$ & " at line: " & erl
Resume final
End Function
published solution on github:
https://github.com/dpastov/DominoReplicationHistoryCleaner
Related
I would like to write a simple macro to lift all sheet protection at once. It work's fine. But i would like to make 2 options of it.
1st to use inputbox to write password. Simple
2nd where I need your help, is to use Windows User names to define which are allowed to unprotect it without password (password is in code already defined).
How to use Environ.user to define which user can use that macro?
For example user: 1st "hackla" and 2nd "klaud"
My basic code looks so:
Sub TabelleEntsperren()
Dim strPassw As String
Dim wSheet As Worksheet
strPassw = "Athens"
For Each wSheet In ActiveWorkbook.Worksheets
wSheet.Unprotect Password:=strPassw
Next wSheet
End Sub
Do you mean something like this?
Sub TabelleEntsperren()
Const strPassw As String = "yourPassword"
Const usr1 As String = "hackla"
Const usr2 As String = "klaud"
Dim wSheet As Worksheet
Dim isTrustedUser As Boolean
Dim currentUsr As String
currentUsr = Environ("username")
isTrustedUser = currentUsr = usr1 Or currentUsr = usr2
For Each wSheet In ActiveWorkbook.Worksheets
If isTrustedUser Then wSheet.Unprotect Password:=strPassw
Next wSheet
End Sub
Option Explicit
'Private API declarations
#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
#Else
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBudffer As String, nSize As Long) As Long
#End If
'To get the computer name
Public Function getActiveComputerName() As String
Dim cn As String, ls As Long, res As Long
cn = String(1024, 0)
ls = 1024
res = GetComputerName(cn, ls)
If res <> 0 Then
getActiveComputerName = Mid$(cn, 1, InStr(cn, Chr$(0)) - 1)
Else
getActiveComputerName = ""
End If
End Function
'To get the identifier for the active user
Public Function getActiveUserName() As String
Dim cn As String, ls As Long, res As Long
cn = String(1024, 0)
ls = 1024
res = GetUserName(cn, ls)
If res <> 0 Then
getActiveUserName = Mid$(cn, 1, InStr(cn, Chr$(0)) - 1)
Else
getActiveUserName = ""
End If
End Function
If an open workbook (located on a server) is in read only mode, how can I display the active username using VBA?
I've looked into .WriteReservedBy but this only shows the name of the person that last saved the file with a password.
This should probably be a comment but my reputation is too low
I've seen this but never needed the info...
Things to try:
ThisWorkbook.UserStatus - array with all current users for the file open as exclusive or shared
Environ("USERNAME")
CreateObject("WScript.NetWork").UserName
API calls:
.
Declare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA"
( _
ByVal lpName As String, _
ByVal lpUserName As String, _
lpnLength As Long
) As Long
Declare Function GetUserName& Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long)
.
more details about these APIs:
https://support.microsoft.com/en-us/kb/161394
http://www.vbaexpress.com/kb/getarticle.php?kb_id=768
WMI Win32_NetworkConnection:
Public Function GetActiveUser(Optional ByVal computer As String = ".") As String
Dim wmi As Object, itm As String
On Error Resume Next
Set wmi = GetObject("winmgmts:\\" & computer & "\Root\CIMv2")
itm = wmi.ExecQuery("Select UserName from Win32_NetworkConnection", , 48)
GetNetActiveUser = itm
End Function
Goal
Have an Excel file with a "Search" button that opens a custom program. This program is used for researches. If the program is already opened when the user clicks on the button, make it popup and focus on that given program.
Current Situation
Here's the code I'm trying to use to make it work:
Search Button
Private Sub btnSearch_Click()
Dim x As Variant
Dim Path As String
If Not IsAppRunning("Word.Application") Then
Path = "C:\Tmp\MyProgram.exe"
x = Shell(Path, vbNormalFocus)
End If
End Sub
IsAppRunning()
Function IsAppRunning(ByVal sAppName) As Boolean
Dim oApp As Object
On Error Resume Next
Set oApp = GetObject(, sAppName)
If Not oApp Is Nothing Then
Set oApp = Nothing
IsAppRunning = True
End If
End Function
This code will work only when I put "Word.Application" as the executable. If I try to put "MyProgram.Application" the function will never see the program is running. How can I find that "MyProgram.exe" is currently opened?
Further more, I'd need to put the focus on it...
You can check this more directly by getting a list of open processes.
This will search based on the process name, returning true/false as appropriate.
Sub exampleIsProcessRunning()
Debug.Print IsProcessRunning("MyProgram.EXE")
Debug.Print IsProcessRunning("NOT RUNNING.EXE")
End Sub
Function IsProcessRunning(process As String)
Dim objList As Object
Set objList = GetObject("winmgmts:") _
.ExecQuery("select * from win32_process where name='" & process & "'")
IsProcessRunning = objList.Count > 0
End Function
Here's how I brought the search window to front:
Private Const SW_RESTORE = 9
Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Sub btnSearch_Click()
Dim x As Variant
Dim Path As String
If IsProcessRunning("MyProgram.exe") = False Then
Path = "C:\Tmp\MyProgram.exe"
x = Shell(Path, vbNormalFocus)
Else
Dim THandle As Long
THandle = FindWindow(vbEmpty, "Window / Form Text")
Dim iret As Long
iret = BringWindowToTop(THandle)
Call ShowWindow(THandle, SW_RESTORE)
End If
End Sub
Now if the window was minimized and the user clicks the search button again, the window will simply pop up.
Just want to point out that the Window Text may change when documents are open in the application instance.
For example, I was trying to bring CorelDRAW to focus and everything would work fine so long as there wasn't a document open in Corel, if there was, I would need to pass the complete name to FindWindow() including the open document.
So, instead of just:
FindWindow("CorelDRAW 2020 (64-Bit)")
It would have to be:
FindWindow("CorelDRAW 2020 (64-Bit) - C:\CompletePath\FileName.cdr")
As that is what would be returned from GetWindowText()
Obviously this is an issue as you don't know what document a user will have open in the application, so for anyone else who may be coming here, years later, who may be experiencing the same issue, here's what I did.
Option Explicit
Private Module
Private Const EXE_NAME As String = "CorelDRW.exe"
Private Const WINDOW_TEXT As String = "CorelDRAW 2020" ' This is common with all opened documents
Private Const GW_HWNDNEXT = 2
Private Const SW_RESTORE = 9
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Sub FocusIfRunning(parAppName as String, parWindowText as String)
Dim oProcs As Object
Dim lWindowHandle As Long
Dim sWindowText As String
Dim sBuffer As String
' Create WMI object and execute a WQL query statement to find if your application
' is a running process. The query will return an SWbemObjectSet.
Set oProcs = GetObject("winmgmts:").ExecQuery("SELECT * FROM win32_process WHERE " & _
"name = '" & parAppName & "'")
' The Count property of the SWbemObjectSet will be > 0 if there were
' matches to your query.
If oProcs.Count > 0 Then
' Go through all the handles checking if the start of the GetWindowText()
' result matches your WindowText pre-file name.
' GetWindowText() needs a buffer, that's what the Space(255) is.
lWindowHandle = FindWindow(vbEmpty, vbEmpty)
Do While lWindowHandle
sBuffer = Space(255)
sWindowText = Left(sBuffer, GetWindowText(lWindowHandle, sBuffer, 255))
If Mid(sWindowText, 1, Len(parWindowText)) Like parWindowText Then Exit Do
' Get the next handle. Will return 0 when there are no more.
lWindowHandle = GetWindow(lWindowHandle, GW_HWNDNEXT)
Loop
Call ShowWindow(lWindowHandle , SW_RESTORE)
End If
End Sub
Private Sub btnFocusWindow_Click()
Call FocusIfRunning(EXE_NAME, WINDOW_TEXT)
End Sub
Hopefully somebody gets use from this and doesn't have to spend the time on it I did.
Just wanted to say thank you for this solution. Only just started playing around with code and wanted to automate my job a bit. This code will paste current selection in excel sheet into an already open application with as single click. Will make my life so much easier!!
Thanks for sharing
Public Const SW_RESTORE = 9
Public Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Sub updatepart()
'
' updatepart Macro
' copies current selection
' finds and focuses on all ready running Notepad application called Test
' pastes value into Notepad document
' Keyboard Shortcut: Ctrl+u
'
Dim data As Range
Set data = Application.Selection
If data.Count <> 1 Then
MsgBox "Selection is too large"
Exit Sub
End If
Selection.Copy
If IsProcessRunning("Notepad.EXE") = False Then
MsgBox "Notepad is down"
Else
Dim THandle As Long
THandle = FindWindow(vbEmpty, "Test - Notepad")
Dim iret As Long
iret = BringWindowToTop(THandle)
Call ShowWindow(THandle, SW_RESTORE)
End If
waittime (500)
'Call SendKeys("{F7}")
Call SendKeys("^v", True) '{F12}
Call SendKeys("{ENTER}")
End Sub
Function waittime(ByVal milliseconds As Double)
Application.Wait (Now() + milliseconds / 24 / 60 / 60 / 1000)
End Function
Function IsProcessRunning(process As String)
Dim objList As Object
Set objList = GetObject("winmgmts:") _
.ExecQuery("select * from win32_process where name='" & process & "'")
If objList.Count > 0 Then
IsProcessRunning = True
Else
IsProcessRunning = False
End If
End Function
i'm working with lotus notes 6.5.6 and sometimes, when users try to exegute an agent notes retrive "loading USE or USELSX module" error so, i have to go into the library that is used my that agent and re-save it. After that the agent work. I don't know the cause of this error but i'm studying for understand it, meantime i have to find a solution that allow users to solve the problem without my presence.
So i'm look for a solution that allow users to access the library and resave it to solve that error.
I try to do this:
Dim db As NotesDatabase
Dim session As New NotesSession
Dim doclib As NotesDocument
Dim colllib As NotesNoteCollection
Dim id As String
Set db=session.CurrentDatabase
Set colllib = db.CreateNoteCollection(False)
colllib.SelectScriptLibraries=True
Call colllib.BuildCollection()
Id=colllib.GetFirstNoteId
While Not Id=""
Set doclib=db.GetDocumentByID(Id)
If Not doclib Is Nothing Then
Call doclib.ComputeWithForm(False,False)
Call doclib.Save(True,False)
End If
id=colllib.GetNextNoteId(Id)
Wend
but the error is not resolved.
How can i do ?
thank's
In order to resolve your issue you would need to recompile the script (what is automatically done when saving it in the Designer- Client) and then programmatically sign it (what is only possible using the C-API). Calling a "ComputeWithForm" on a Design- Element does NOT recompile the script.
Rather than fixing something that should not be broken, I would rather investigate why this agent stops running.
Usually this happens, when the designer- task "merges" script- libraries / agents from different templates to one database.
I am quite sure, that the reason for your agent not working anymore is the nightly designer task. Try to take out the template- name from the "broken" database or manipulate it (add an "x" or something) so that you keep the information, but designer task does not find the corresponding template. This should fix your problem.
If you really cannot fix the problem with this approach, then try this code I found here, put it in an agent and let the user call it via another agent with ag.RunOnServer (then it runs with more rights than the user has):
'LS Recompile:
Option Public
Option Explicit
%REM
An example of using Notes API calls to recompile LotusScript.
version 1.0
Julian Robichaux
http://www.nsftools.com
%END REM
'** Notes C-API functions
Declare Function OSPathNetConstruct Lib "nnotes.dll" (Byval portName As Integer, _
Byval serverName As String, Byval fileName As String, Byval pathName As String) As Integer
Declare Function NSFDbOpen Lib "nnotes.dll" (Byval dbName As String, hDb As Long) As Integer
Declare Function NSFDbClose Lib "nnotes.dll" (Byval hDb As Long) As Integer
Declare Function NSFNoteLSCompile Lib "nnotes.dll" (Byval hDb As Long, _
Byval hNote As Long, Byval dwFlags As Long) As Integer
Declare Function NSFNoteSign Lib "nnotes.dll" (Byval hNote As Long) As Integer
Declare Function NSFNoteUpdate Lib "nnotes.dll" (Byval hNote As Long, _
Byval flags As Integer) As Integer
Declare Function OSLoadString Lib "nnotes.dll" (Byval hModule As Long, Byval stringCode As Integer, _
Byval retBuffer As String, Byval bufferLength As Integer) As Integer
'================================================================
' Base class for working with Notes databases at the API level
'================================================================
Class APIBaseClass
Private db As NotesDatabase
Private hDb As Long
Private lastError As String
Public Sub New ()
'** nothing to instantiate in the base class
End Sub
Public Sub Delete ()
Call CloseDatabase()
End Sub
Public Function OpenDatabase (db As NotesDatabase) As Integer
On Error Goto processError
If (hDb > 0) Then
Call CloseDatabase()
End If
'** reset the internals
Set Me.db = db
lastError = ""
Dim pathName As String*256
Dim result As Integer
'** create a proper network path name with OSPathNetConstruct
Call OSPathNetConstruct(0, db.Server, db.FilePath, pathName)
'** open the database and get a handle with NSFDbOpen
result = NSFDbOpen(pathName, hDb)
If result = 0 Then
OpenDatabase = True
Else
Call SetLastError("Cannot open database " & db.FilePath & " on server " & db.Server, result)
End If
Exit Function
processError:
Call SetLastError("Error opening database", 0)
Exit Function
End Function
Public Sub CloseDatabase ()
On Error Resume Next
If (hDb > 0) Then
Call NSFDbClose(hDb)
End If
Set db = Nothing
hDb = 0
lastError = ""
End Sub
Private Function SetLastError (errText As String, apiResultCode As Integer) As String
If (apiResultCode <> 0) Then
LastError = "API Error " & apiResultCode & ": " & GetAPIError(apiResultCode)
Elseif (Err > 0) Then
LastError = "Notes Error " & Err & ": " & Error$
Else
LastError = ""
End If
If (Len(errText) > 0) Then
LastError = errText & ". " & LastError
End If
End Function
Public Function GetLastError () As String
GetLastError = LastError
End Function
Public Function GetAPIError (errorCode As Integer) As String
Dim errorString As String*256
Dim returnErrorString As String
Dim resultStringLength As Long
Dim errorCodeTranslated As Integer
Const ERR_MASK = &H3fff
Const PKG_MASK = &H3f00
Const ERRNUM_MASK = &H00ff
'** mask off the top 2 bits of the errorCode that was returned; this is
'** what the ERR macro in the API does
errorCodeTranslated = (errorCode And ERR_MASK)
'** get the error code translation using the OSLoadString API function
resultStringLength = OSLoadString(0, errorCodeTranslated, errorString, Len(errorString) - 1)
'** strip off the null-termination on the string before you return it
If (Instr(errorString, Chr(0)) > 0) Then
returnErrorString = Left$(errorString, Instr(errorString, Chr(0)) - 1)
Else
returnErrorString = errorString
End If
GetAPIError = returnErrorString
End Function
End Class
'================================================================
' Special subclass for recompiling a note/doc in a database
'================================================================
Class LotusScriptRecompiler As APIBaseClass
Public Function RecompileLSByNoteID (noteID As String) As Integer
On Error Goto processError
If (db Is Nothing) Then
Call SetLastError("Database is not open", 0)
Exit Function
End If
Dim doc As NotesDocument
Set doc = db.GetDocumentByID(noteID)
RecompileLSByNoteID = RecompileLS(doc)
Exit Function
processError:
Call SetLastError("Error recompiling LotusScript for " & noteID, 0)
Exit Function
End Function
Public Function RecompileLSByUNID (unid As String) As Integer
On Error Goto processError
If (db Is Nothing) Then
Call SetLastError("Database is not open", 0)
Exit Function
End If
Dim doc As NotesDocument
Set doc = db.GetDocumentByUNID(unid)
RecompileLSByUNID = RecompileLS(doc)
Exit Function
processError:
Call SetLastError("Error recompiling LotusScript for " & unid, 0)
Exit Function
End Function
Public Function RecompileLS (doc As NotesDocument) As Integer
On Error Goto processError
Dim hNote As Long
Dim unid As String
Dim result As Integer
If (hDb = 0) Then
Call SetLastError("Database is not open", 0)
Exit Function
Elseif (doc Is Nothing) Then
Call SetLastError("Invalid document reference", 0)
Exit Function
End If
'** super-special-secret way of getting an API handle to a NotesDocument
hNote = doc.Handle
unid = doc.UniversalID
'** first, we compile the note
result = NSFNoteLSCompile(hDb, hNote, 0)
If (result <> 0) Then
Call SetLastError("Cannot compile LotusScript for " & GetTitle(doc), result)
Exit Function
End If
'** then we sign it
result = NSFNoteSign(hNote)
If (result <> 0) Then
Call SetLastError("Cannot sign " & GetTitle(doc), result)
Exit Function
End If
'** then we save it
result = NSFNoteUpdate(hNote, 0)
If (result <> 0) Then
Call SetLastError("Cannot save " & GetTitle(doc), result)
Exit Function
End If
'** update the in-memory reference to the object
Delete doc
Set doc = db.GetDocumentByUNID(unid)
'** a little trick to avoid this message on recompiled forms:
'** This document has been altered since the last time it was signed! Intentional tampering may have occurred.
Call doc.Sign()
Call doc.Save(True, False)
lastError = ""
RecompileLS = True
Exit Function
processError:
Call SetLastError("Error recompiling LotusScript for " & GetTitle(doc), 0)
Exit Function
End Function
Public Function GetTitle (doc As NotesDocument) As String
On Error Resume Next
If (doc Is Nothing) Then
Exit Function
End If
Dim title As String
title = doc.~$Title(0)
If (Instr(title, "|") > 0) Then
title = Strleft(title, "|")
End If
If (title = "") Then
title = "(untitled)"
End If
GetTitle = |"| & title & |"|
End Function
End Class
Sub Initialize
'** As a test, let's recompile all the agents, script libraries, and forms
'** in this database
Dim session As New NotesSession
Dim db As NotesDatabase
Dim nc As NotesNoteCollection
Dim recompiler As New LotusScriptRecompiler
Dim noteID As String
'** create our recompiler object
Set db = session.CurrentDatabase
Call recompiler.OpenDatabase(db)
If (recompiler.GetLastError <> "") Then
Print recompiler.GetLastError
Exit Sub
End If
'** compile the script libraries first (note that this will NOT build a
'** dependency tree -- rather, we'll try to brute-force around the
'** dependencies by recompiling until either (A) there are no errors,
'** or (B) the number of errors we get is the same as we got last time)
Dim errCount As Integer, lastCount As Integer
Set nc = db.CreateNoteCollection(False)
nc.SelectScriptLibraries = True
Call nc.BuildCollection
Print "SCRIPT LIBRARIES"
Do
lastCount = errCount
errCount = 0
noteID = nc.GetFirstNoteId
Do Until (noteID = "")
If recompiler.RecompileLSByNoteID(noteID) Then
Print "Successfully recompiled " & _
recompiler.GetTitle(db.GetDocumentByID(noteID))
Else
Print recompiler.GetLastError
errCount = errCount + 1
End If
noteID = nc.GetNextNoteId(noteID)
Loop
Loop Until ( (errCount = 0) Or (errCount = lastCount) )
'** then compile everything else
Set nc = db.CreateNoteCollection(False)
nc.SelectAgents = True
nc.SelectForms = True
Call nc.BuildCollection
Print "FORMS AND AGENTS"
noteID = nc.GetFirstNoteId
Do Until (noteID = "")
If recompiler.RecompileLSByNoteID(noteID) Then
Print "Successfully recompiled " & _
recompiler.GetTitle(db.GetDocumentByID(noteID))
Else
Print recompiler.GetLastError
End If
noteID = nc.GetNextNoteId(noteID)
Loop
Call recompiler.CloseDatabase()
Print "All done"
End Sub
I need to issue an HTTP Get with a query string to a web service from Excel for Mac 2011. I've seen the answers for using QueryTables (How can I send an HTTP POST request to a server from Excel using VBA?) but they use the POST method, not a GET method. I also see that it's easy from a Windows machine, but I'm stuck on a Mac.
Any suggestions, or is it hopeless?
Doing further research, I came across Robert Knight's comment on this question VBA Shell function in Office 2011 for Mac and built an HTTPGet function using his execShell function to call curl. I've tested this on a Mac running Mac OS X 10.8.3 (Mountain Lion) with Excel for Mac 2011. Here is the VBA code:
Option Explicit
' execShell() function courtesy of Robert Knight via StackOverflow
' https://stackoverflow.com/questions/6136798/vba-shell-function-in-office-2011-for-mac
Private Declare Function popen Lib "libc.dylib" (ByVal command As String, ByVal mode As String) As Long
Private Declare Function pclose Lib "libc.dylib" (ByVal file As Long) As Long
Private Declare Function fread Lib "libc.dylib" (ByVal outStr As String, ByVal size As Long, ByVal items As Long, ByVal stream As Long) As Long
Private Declare Function feof Lib "libc.dylib" (ByVal file As Long) As Long
Function execShell(command As String, Optional ByRef exitCode As Long) As String
Dim file As Long
file = popen(command, "r")
If file = 0 Then
Exit Function
End If
While feof(file) = 0
Dim chunk As String
Dim read As Long
chunk = Space(50)
read = fread(chunk, 1, Len(chunk) - 1, file)
If read > 0 Then
chunk = Left$(chunk, read)
execShell = execShell & chunk
End If
Wend
exitCode = pclose(file)
End Function
Function HTTPGet(sUrl As String, sQuery As String) As String
Dim sCmd As String
Dim sResult As String
Dim lExitCode As Long
sCmd = "curl --get -d """ & sQuery & """" & " " & sUrl
sResult = execShell(sCmd, lExitCode)
' ToDo check lExitCode
HTTPGet = sResult
End Function
To use this, copy the code above, open the VBA editor in Excel for Mac 2011. If you don't have a module, click Insert->Module. Paste the code into the module file. Leave the VBA editor (clover-Q).
Here's a specific example using a weather forecast web service (http://openweathermap.org/wiki/API/JSON_API)
Cell A1 will be reserved for the name of the city.
In cell A2, enter the URL string: http://api.openweathermap.org/data/2.1/forecast/city
In cell A3 which will build the query string, enter: ="q=" & A1
In cell A4, enter: =HTTPGet(A2, A3)
Now, type a city name in cell A1, for example London, cell A4 will show you the JSON response containing the weather forecast for London. Change the value in A1 from London to Moscow -- A4 will change to the JSON-formatted forecast for Moscow.
Obviously, using VBA, you could parse and reformat the JSON data and place it where needed in your worksheet.
No claims for performance or scalability, but for a simple one-shot access to a web service from Excel for Mac 2011, this seems to do the trick and met the need for which I posted my original question. YMMV!
The answer above from John Stephens is fantastic (please upvote it!), but it no longer worked for me in the more recent Excel:mac 2016, with an error that the code needs to be updated for use on 64-bit systems.
Taking some tips from an issue I found in a related repository, I was able to adjust the data types in John's script to work correctly in Excel:mac 2016:
Option Explicit
' execShell() function courtesy of Robert Knight via StackOverflow
' http://stackoverflow.com/questions/6136798/vba-shell-function-in-office-2011-for-mac
Private Declare PtrSafe Function popen Lib "libc.dylib" (ByVal command As String, ByVal mode As String) As LongPtr
Private Declare PtrSafe Function pclose Lib "libc.dylib" (ByVal file As LongPtr) As Long
Private Declare PtrSafe Function fread Lib "libc.dylib" (ByVal outStr As String, ByVal size As LongPtr, ByVal items As LongPtr, ByVal stream As LongPtr) As Long
Private Declare PtrSafe Function feof Lib "libc.dylib" (ByVal file As LongPtr) As LongPtr
Function execShell(command As String, Optional ByRef exitCode As Long) As String
Dim file As LongPtr
file = popen(command, "r")
If file = 0 Then
Exit Function
End If
While feof(file) = 0
Dim chunk As String
Dim read As Long
chunk = Space(50)
read = fread(chunk, 1, Len(chunk) - 1, file)
If read > 0 Then
chunk = Left$(chunk, read)
execShell = execShell & chunk
End If
Wend
exitCode = pclose(file)
End Function
Function HTTPGet(sUrl As String, sQuery As String) As String
Dim sCmd As String
Dim sResult As String
Dim lExitCode As Long
sCmd = "curl --get -d """ & sQuery & """" & " " & sUrl
sResult = execShell(sCmd, lExitCode)
' ToDo check lExitCode
HTTPGet = sResult
End Function
Another option (update accordingly if your curl is not located in /opt/local/bin/curl):
VBA:
Public Function getUrlContents(url) As String
Dim command As String
command = "do shell script ""/path_to/getUrl.sh " + url + """"
getUrlContents = VBA.MacScript(command)
End Function
/path_to/getUrl.sh:
#!/bin/sh
if [ -z "$1" ]
then
echo "missing url argument"
else
/opt/local/bin/curl "$1"
fi
Note that you will have to ensure that getUrl.sh is executable:
chmod u+x getUrl.sh