Accessing my digital camera

if you are able to see it in explorer,
you can access the files with vb just like any other directory

but it doesn't show up with a drive letter......

so how can you view it in explorer then?

it is listed under 'My Computer' as the name of the camera: Canon A620 ...

please try this:


create a new project
(default exe)

add one button (Command1)

paste the code below, and run the program
now click on command1, and there should pop up a box

try to find your camera in that, and then click ok

a messagebox should pop, telling you the path you can use to access it.




Option Explicit

Private Type BrowseInfo
    hwndOwner      As Long
    pIDLRoot       As Long
    pszDisplayName As Long
    lpszTitle      As Long
    ulFlags        As Long
    lpfnCallback   As Long
    lParam         As Long
    iImage         As Long
End Type

Private Const BIF_EDITBOX = &H10
Private Const BIF_NEWDIALOGSTYLE = &H40
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_USENEWUI = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX)
Private Const MAX_PATH = 260
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Const CSIDL_DESKTOP = &H0

Private Type SHITEMID
    cb   As Long
    abID As Byte
End Type

Private Type ITEMIDLIST
    mkid As SHITEMID
End Type

Private Declare Function SHGetSpecialFolderLocation Lib "Shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function OleInitialize Lib "ole32.dll" (lp As Any) As Long

Private Declare Sub OleUninitialize Lib "ole32" ()

Private Function fGetSpecialFolder(CSIDL As Long, IDL As ITEMIDLIST) As String
    Dim sPath As String
    fGetSpecialFolder = ""
    If SHGetSpecialFolderLocation(Me.hWnd, CSIDL, IDL) = 0 Then
        sPath = Space$(MAX_PATH)
        If SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath) Then
            fGetSpecialFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1) & "\"
        End If
    End If
End Function



Public Function fBrowseForFolder(hwndOwner As Long, sPrompt As String) As String
Dim iNull    As Integer
Dim lpIDList As Long
Dim lResult  As Long
Dim sPath    As String
Dim sPath1   As String
Dim udtBI    As BrowseInfo
Dim IDL      As ITEMIDLIST

    sPath1 = fGetSpecialFolder(CSIDL_DESKTOP, IDL)
   
    Call OleInitialize(ByVal 0&)
   
    With udtBI
        .pIDLRoot = IDL.mkid.cb 'Use the desired starting folder.
        .hwndOwner = hwndOwner
        .lpszTitle = lstrcat(sPrompt, "")
        .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_USENEWUI
    End With
   
    lpIDList = SHBrowseForFolder(udtBI)

    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        lResult = SHGetPathFromIDList(lpIDList, sPath)
        Call CoTaskMemFree(lpIDList)
       
        iNull = InStr(sPath, vbNullChar)
        If iNull Then sPath = Left$(sPath, iNull - 1)
    End If

    Call OleUninitialize
    fBrowseForFolder = sPath
End Function

Private Sub Command1_Click()
Dim sStr As String
    sStr = fBrowseForFolder(hWnd, "Select your usb device")
    If sStr <> "" Then
        MsgBox sStr, vbInformation, "Directory Browser"
    End If
End Sub

Wow, this was a lot of work!
Thanks!

However, I don't see my camera listed whee the 'Select your USB device" pop up shows up....

Any hints?
If you can make this happen, I will award 500 points.....

please eject your camera from your system

browse to this example:
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=61104&lngWId=1


download the files, and extract them to a free (new ) directory


start the program,
and clear the textbox if some text appears


DON'T PRESS THE STOP BUTTON WHEN YOU ARE FINISHED IN VB!
it will crash your vb because the example uses subclassing


now insert your device in your usb port
wait for the data to stop, and the windows dialog to pop up (asking you what to do)
if that dialog doesnt pop, just wait for the text in the textbox to stop

now please paste all that text here

these two lines showed up in textbox when I connected the camera:

DBT_DEVNODES_CHANGED : lParam = 0(0H)
DBT_DEVNODES_CHANGED : lParam = 0(0H)

that's a lot less then i expected......



then let's try this



create a new file on your desktop called listusb.vbs

(actually, the first part doesnt matter, it's the extension that matters)

paste the text below in it


now press ok until you can see the connected device you are looking for, or until there is no messagebox anymore.

please report back if you found it (or not)


'code:


Sub ListUsbProperties( strComputer )

          Dim objWMIService, colItems
          
          Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
          Set colItems = objWMIService.ExecQuery("Select * from Win32_USBController",,48)
          For Each objItem In colItems
                Wscript.Echo "Availability: " & objItem.Availability & vblf & _
                "Caption: " & objItem.Caption & vblf & _
                "ConfigManagerErrorCode: " & objItem.ConfigManagerErrorCode & vblf & _
                "ConfigManagerUserConfig: " & objItem.ConfigManagerUserConfig & vblf & _
                "CreationClassName: " & objItem.CreationClassName & vblf & _
                "Description: " & objItem.Description & vblf & _
                "DeviceID: " & objItem.DeviceID & vblf & _
                "ErrorCleared: " & objItem.ErrorCleared & vblf & _
                "ErrorDescription: " & objItem.ErrorDescription & vblf & _
                "InstallDate: " & objItem.InstallDate & vblf & _
                "LastErrorCode: " & objItem.LastErrorCode & vblf & _
                "Manufacturer: " & objItem.Manufacturer & vblf & _
                "MaxNumberControlled: " & objItem.MaxNumberControlled & vblf & _
                "Name: " & objItem.Name & vblf & _
                "PNPDeviceID: " & objItem.PNPDeviceID & vblf & _
                "PowerManagementCapabilities: " & objItem.PowerManagementCapabilities & vblf & _
                "PowerManagementSupported: " & objItem.PowerManagementSupported & vblf & _
                "ProtocolSupported: " & objItem.ProtocolSupported & vblf & _
                "Status: " & objItem.Status & vblf & _
                "StatusInfo: " & objItem.StatusInfo & vblf & _
                "SystemCreationClassName: " & objItem.SystemCreationClassName & vblf & _
                "SystemName: " & objItem.SystemName & vblf & _
                "TimeOfLastReset: " & objItem.TimeOfLastReset
          Next
End Sub

ListUsbProperties( "." )

there are two dialog boxes which pop-up.
First: 'Caption' is Standard OpenHCD USB Host Controller
Second: Standard Enhanced PCI to USB Host Controller

that is all.....
is it helpful?

no, that was not what i was looking for.


I'm sorry, that is all i know about usb.

one more thing that pops up,


if you go to device manager (start->run->"devmgmt.msc")

at what category is the device listed?

and please also try
start->run->"msinfo32.exe"

and try to find the device at the "Components" tree item (there could be more instances)

It is listed under imaging devices in device manager

In msinfo32.exe, It is under USB with a PNP Device ID of:
Canon PowerShot A620      USB\VID_04A9&PID_30FC\5&2609FE24&0&2

does that help?

yes that does help, but it is a bit beyond my knowledge

anyway, let's give this a shot:




create a new project

click in the menu on project->references
and scroll down until you see microsoft windows image acquisition ......
tick the box, and click on ok


now try the code attached below.

please note, i have currently no wia enabled hardware, so i cannot try it
you have to experiment with it yourself.
The code completion should get you started, type "wialib." and there should pop a box telling you all possibilities




Private Sub Form_Load()

Dim objWia As WIALib.Wia
Dim objDeviceInfoCollection As WIALib.Collection
Dim objDeviceInfo As WIALib.DeviceInfo
Dim objRootItem As WIALib.Item
Dim objSelectedItems As WIALib.Item
 
    Set objWia = New Wia
     
    Me.AutoRedraw = True
   
    Set objDeviceInfoCollection = objWia.Devices
   
    For Each objDeviceInfo In objDeviceInfoCollection
        Set objRootItem = objWia.Create(objDeviceInfo)
        Set objSelectedItems = objRootItem.GetItemsFromUI(0, 0)
       
        Me.Print objRootItem.FullName
        Me.Print objSelectedItems.FullName
    Next
End Sub

I think we're making progress......

When I run, I get a 'Run-Time 13' Type Mismatch error on this line:
        Set objRootItem = objWia.Create(objDeviceInfo)

I did a Watch on objDeviceInfo and it looks like the camera info is there:
    : Id : "{6BDD1FC6-810F-11D0-BEC7-08002BE2092F}\0001" : String : Form1.Form_Load
    : Manufacturer : "Generic" : String : Form1.Form_Load
    : Name : "Canon PowerShot A620" : String : Form1.Form_Load
    : Port : "\\.\Usbscan0" : String : Form1.Form_Load
    : Type : "DigitalCamera" : String : Form1.Form_Load
    : UIClsid : "{4DB1AD10-3391-11D2-9A33-00C04FA36145}" : String : Form1.Form_Load

I would consider myself to be a VB novice so I appreciate any and all guidance you can give!!!

i'm currently trying to acquire a twain device, so i'll check back in a moment when i can debug

as for now, change the declaration to this:

Dim objRootItem


vb will try to find the apropriate type

now single step trough the code,
until you are ONE line below the line set objrootitem......

now execute the command below (without quotes) in the immediate window,
and report the value back
"?typename(objRootItem)"

ok, got it up and running
unfortunately i can't try it with a camera, since i only got a scanner.


but this code should work:
replace the me.print .... fullname with the code you care about,
see code completion for all possibilities.

Option Explicit

Private Sub Form_Load()

Dim objWia As Wia
Dim objDeviceInfoCollection As WIALib.Collection
Dim objDeviceInfo  As DeviceInfo
Dim objRootItem As WIALib.Item
Dim objSelectedItems As WIALib.Collection
Dim objExtraItem As WIALib.Item
 
    Set objWia = New Wia
     
    Me.AutoRedraw = True
   
    Set objDeviceInfoCollection = objWia.Devices
   
    Me.Print objDeviceInfoCollection.Count
    For Each objDeviceInfo In objDeviceInfoCollection
        Set objRootItem = objDeviceInfo.Create
        Set objSelectedItems = objRootItem.GetItemsFromUI(0, 0)
       
        Me.Print objRootItem.FullName
         For Each objExtraItem In objSelectedItems
            Me.Print objExtraItem.FullName
         Next
    Next
End Sub

Same thing, I can't get past the line:   Set objRootItem = objWia.Create(objDeviceInfo)
even with the change

did you try the all new code?

we must be posting at the same time... LOL I didn't see the new stuff!!

That works perfectly!!!
It opens up the camera's dialog box, I can see my pix, select them, etc.
Now, for what shoudl be my final question.....
How can I save them?
I've been playing with FSO, etc and keep getting an error such as "Path not found"
This line: "FSO.CopyFile objExtraItem.FullName, strDestinationFile"
I am thinkign it is the objExtraItem.FullName as it isn't a 'path'.............

nope it isnt


please bare with me a minute, almost finished my code :)

np.

btw, this seemed to work:
 objExtraItem.Transfer "c:\" & objExtraItem.Name & ".jpg"
but the pix are now 20MB when they are only about 1.5MB ......

let's put this in an all new project, just to make sure no stuff is going wrong :)

add the reference again
>>click in the menu on project->references
>>and scroll down until you see microsoft windows image acquisition ......
>>tick the box, and click on ok



now paste the code below

please note a few differences.
the variable objWia is now declared private withevents on a global scope.
this means we can now receive wia events!

the bottom 3 functions are the events that exist for the wia object, the names are self explaining.


this part is also new:
            strTmp = GetTempFile
            objExtraItem.Transfer strTmp, True

first it retreives a new file name (random) in the current application path
this is stored in strTmp
(strTmp = GetTempFile)

after that, the file is copied Asynchronous (the True behind it) so your code will not hang on the copying.
this is done for all files (For Each objExtraItem In objSelectedItems)


now for every file copied, the objWia_OnTransferComplete is fired


have fun!



attached code:





Option Explicit

Private WithEvents objWia As Wia

Private Sub Form_Load()
Dim objDeviceInfoCollection As WIALib.Collection
Dim objDeviceInfo  As DeviceInfo
Dim objRootItem As WIALib.Item
Dim objSelectedItems As WIALib.Collection
Dim objExtraItem As WIALib.Item
Dim strTmp As String
    Set objWia = New Wia
     
    Me.AutoRedraw = True
   
    Set objDeviceInfoCollection = objWia.Devices
   
   
    Me.Print "Please wait for the device to finish transferring files!"
       
    For Each objDeviceInfo In objDeviceInfoCollection
        Set objRootItem = objDeviceInfo.Create
        Set objSelectedItems = objRootItem.GetItemsFromUI(SingleImage, ImageTypeColor)
       
         For Each objExtraItem In objSelectedItems
            strTmp = GetTempFile
            objExtraItem.Transfer strTmp, True
         Next
    Next
End Sub


Private Function GetTempFile() As String
Dim strBuf As String
    strBuf = App.Path
    Randomize
    If Right$(strBuf, 1) <> "\" Then strBuf = strBuf & "\"
    strBuf = strBuf & CLng(Rnd * 15245) & ".bmp"
    GetTempFile = strBuf
End Function

Private Sub objWia_OnDeviceConnected(ByVal Id As String)
    MsgBox "Device connected: " & Id
End Sub

Private Sub objWia_OnDeviceDisconnected(ByVal Id As String)
    MsgBox "Device disconnected: " & Id
End Sub


Private Sub objWia_OnTransferComplete(ByVal Item As WIALib.IWiaDispatchItem, ByVal Path As String)
    MsgBox "File """ & Path & """ saved. (" & Item.GetPropById(PictureBufferSize) & ") bytes"
End Sub

this is very cool, thanks for showing my alternate ways and things to do!

Not sure if you saw last post, photos are still HUGE!!!!

that is because they are stored as bmp


i have now downloaded version 2.0 of the image acquisition, because you can change file format with that

however, it is all different
so basically i have to rewrite the code

get version 2.0 here:

http://www.microsoft.com/downloads/details.aspx?FamilyID=a332a77a-01b8-4de6-91c2-b7ea32537e29&DisplayLang=en#filelist

I can't thank you enough.

i'll return tomorrow to this question,

i gotta take some sleep tonight (yesterday i got only 3 hours)



hope i can create another example with version 2.0 then.
in the meantime, you could download the file(s),
and install them.

try to build your own project from the documentation


i suggest you to start here in the documentation:
"Overviews/Tutorials"->"Shared samples"->"Count the Number of Child Items Available for Transfer"


paste that in a new project, add reference to the 2.0 library, and you are good to go.
remove the comment item's from the declarations, so you can play with the code completion.


this is also interesting code:
"Overviews/Tutorials"->"Shared samples"->"Convert a File"


mark

this was extremely helpful...
After downloading, I was able to work with the samples to create a new project very, very close to what I want.

I am able to open the images from the camera and do other things...even to take a picture!!!! LOL
What I can't seem to get is the name of the pic off the camera, I see the properties including date/time, shutter, camera, on and on but not the name of the pic.
ANy suggestiosn?

The other thing i would like to do is bascially to 'cycle' through all pics on the camera and then save them off..... I can use sample "Count the Number of Child Items Available for Transfer" to see how many photos are there but it doesn't seem to loop through to save....

there really ar the last two items.....

modified the sample "Count Root Level Images for Transfer" to print all available names
(full name & filename (both exclude the extension!) and the extension)


Option Explicit

Dim objWia As WIA.CommonDialog

Private Sub Form_Load()
Dim d As Device
Dim itm As Item

    Me.AutoRedraw = True
    Set objWia = New WIA.CommonDialog
    Set d = objWia.ShowSelectDevice
    For Each itm In d.Items
        Dim f As Properties
        Set f = itm.Properties
       
        If (f.Item("Item Flags") And ImageItemFlag) = ImageItemFlag Then
            Me.Print _
            f.Item("Full Item Name") & vbCrLf & _
            f.Item("Item Name") & vbCrLf & _
            f.Item("Filename extension")
        End If
    Next

End Sub

this is awesome!
It is exactly what I wanted/need!!!

I wish I could award more than 500!!!
(maybe I will post another question soon that you can answer.......???)

Mark_FreeSoftware:

See also:
https://www.experts-exchange.com/questions/22490735/Working-with-WIA-and-a-digital-camera.html