Sub getSnapshot()
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim RetVal, base, i, picName, picPath
picNumber = picNumber + 1
picName = "image.bmp"
' Make sure the current directory is set to the one
' where the Excel file is saved
ChDir (ActiveWorkbook.Path)
base = ActiveWorkbook.Path & "\"
picPath = base & picName
'MsgBox (base)
' First, delete image file if present
If objFSO.FileExists(picPath) Then
dsm "Deleting old file..."
Kill (picPath)
End If
' Now, wait until image file is definitely gone
i = 0
While Dir(picPath) > "" Or i > 10
Application.Wait (Now + TimeValue("00:00:01"))
dsm "Waiting to be sure the image is gone... " & i
i = i + 1
Wend
'MsgBox ("about to take a picture")
' Capture new image
RetVal = Shell(base & "CommandCam.exe /filename """ & picPath & """", 1)
' Wait until image file is definitely there
i = 0
While Dir(picPath) = "" Or i > 20
Application.Wait (Now + TimeValue("00:00:01"))
dsm "Waiting for the image to appear... " & i
i = i + 1
Wend
' Short delay to let new file finish saving
dsm "Waiting another two seconds"
Application.Wait (Now + TimeValue("00:00:02"))
' Load new image into image object on spreadsheet
dsm "Attempting to load the picture on a new tab "
NewPictureSheet picPath, "Picture " & picNumber
dsm "all done"
End Sub
Sub dsm(msg As String)
Cells(6, 9).Value = msg
End Sub
Sub NewPictureSheet(ByVal picLocation As String, ByVal sheetName As String)
dsm "Creating a new sheet..."
' Create a new sheet
Dim newsheet
Set newsheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
newsheet.Name = sheetName
Worksheets(sheetName).Activate
' Put the picture in the new sheet
'pasteAt = Cells(2, 2)
Cells(1, 1).Select 'This is where picture will be inserted
ActiveSheet.Pictures.Insert (picLocation)
Application.ScreenUpdating = True
Exit Sub
ErrNoPhoto:
MsgBox "Unable to Find Photo" 'Shows message box if picture not found
Exit Sub
End Sub