I've been a bit busy of late, but here is some code to control the camera through VBA. I'm using chdkptp.exe in command line mode and invoking it from VBA. One issue is that chdkptp uses output to the console for feedback so I've adopted a more complicated method than the standard SHELL command to get the results back into VBA. I re-direct the output to a file and then wait for completion. (You can in theory read the partial results from the file.) The advantage of this method is that it does not freeze Excel while it is running CHDKPTP.
I've created an Execute function which I will list later, but here is a usage example:
StartTime = Timer()
'This command connects to the camera, sets it to record mode, shoots and then returns
'the image file back to the current directory.
'The workbook containing this code should be in the same directory as chdkptp
Params = "-c -e=reconnect -e=rec -e=""shoot -dl "" "
result = Execute(ThisWorkbook.Path, "chdkptp.exe " & Params)
Elapsed = Timer() - StartTime
Debug.Print "CaptureImage Result:"; result
You should now have the console output in the string 'result'. You can find the file name returned as follows:
Debug.Print "CaptureImage Result:"; result
'eg A/DCIM/109___08/IMG_0428.JPG->IMG_0428.JPG (plus VBCRLF at end)
Offset = InStr(1, result, "->")
If Offset > 0 Then
'remove trailing crlf
LastFile = Replace(Mid(result, Offset + 2), vbCrLf, "")
Debug.Print "Image Name:'"; LastFile; "'"
'Check if the file has actually been created
LastFile = Dir(CurrentDirectory & "\" & LastFile, vbNormal)
GoTo foundit
ELSE
End If
foundit:
Here is the Execute function:
'This declaration needs to be at the top of the module
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Function Execute(WorkingDirectory, MyCommand As String, Optional WaitFor = 30)
On Error GoTo handler
Dim WshShell, objExecObject, strText, i, Now, OutputFile, fileobj, RunThis As String
Set WshShell = VBA.CreateObject("WScript.Shell")
WshShell.CurrentDirectory = WorkingDirectory
'This file could be put anywhere you like
OutputFile = "c:\MyResult.log"
On Error Resume Next
Kill OutputFile 'Raises error if file does not exist
On Error GoTo handler
RunThis = "%COMSPEC% /c """ + MyCommand + """ > " & OutputFile
Debug.Print "Executing:" & RunThis
Now = Timer()
Set objExecObject = WshShell.Exec(RunThis)
Debug.Print "Waiting for output to complete"
Do Until Timer() - Now > WaitFor
If Timer() - Now < 0 Then Now = Timer() 'Just in case you run this at midnight
If objExecObject.Status <> 0 Then
Set FSO = CreateObject("Scripting.FileSystemObject")
Set fileobj = FSO.OpenTextFile(OutputFile, 1)
strText = fileobj.ReadAll
fileobj.Close
Application.StatusBar = "Execute Command Finished Normally. Took " & Format(Timer() - Now, "### seconds")
Debug.Print strText
GoTo done
End If
Application.StatusBar = "Executing command " & String(i, ".")
Sleep (1000)
DoEvents
Loop
Application.StatusBar = "Execute Timed out."
done:
'set result to entire output
Set objExecObject = Nothing
Set WshShell = Nothing
Execute = strText
Application.visible = msoTrue
Exit Function
handler:
MsgBox "Error while executing command. " & Err.Description
Stop
Resume Next
End Function
