Accessing my digital camera

Is there a way in VB to access a digital camera connected via USB?

My purpose would be to copy photos off and to a directory.

I can see the camera when I open up windows explorer so I think there's gotta be a way......
scbdpmAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Mark_FreeSoftwareCommented:

if you are able to see it in explorer,
you can access the files with vb just like any other directory
0
scbdpmAuthor Commented:
but it doesn't show up with a drive letter......
0
Mark_FreeSoftwareCommented:

so how can you view it in explorer then?
0
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

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

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


0
scbdpmAuthor Commented:
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.....
0
Mark_FreeSoftwareCommented:

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

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

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


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( "." )
0
scbdpmAuthor Commented:
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?

0
Mark_FreeSoftwareCommented:

no, that was not what i was looking for.


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






0
Mark_FreeSoftwareCommented:

one more thing that pops up,


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

at what category is the device listed?
0
Mark_FreeSoftwareCommented:
and please also try
start->run->"msinfo32.exe"

and try to find the device at the "Components" tree item (there could be more instances)
0
scbdpmAuthor Commented:
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?
0
Mark_FreeSoftwareCommented:

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
0
scbdpmAuthor Commented:
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!!!
0
Mark_FreeSoftwareCommented:

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

0
Mark_FreeSoftwareCommented:
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)"
0
Mark_FreeSoftwareCommented:
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


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

did you try the all new code?
0
scbdpmAuthor Commented:
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'.............

0
Mark_FreeSoftwareCommented:
nope it isnt


please bare with me a minute, almost finished my code :)
0
scbdpmAuthor Commented:
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 ......
0
Mark_FreeSoftwareCommented:


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

0
scbdpmAuthor Commented:
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!!!!
0
Mark_FreeSoftwareCommented:

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
0
scbdpmAuthor Commented:
I can't thank you enough.

0
Mark_FreeSoftwareCommented:

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
0
scbdpmAuthor Commented:
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.....
0
Mark_FreeSoftwareCommented:

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
0
Mark_FreeSoftwareCommented:

okay, just finished this example,

see comments for explanation
(first past it in vb, the comments turn to green, and are easily spotted :)







Option Explicit

Dim objWia As WIA.CommonDialog

Private Sub Form_Load()
Dim d As Device
Dim itm As Item
Dim imgpic As ImageFile
Dim lCounter As Long
   
    'used for me.print
    'if autoredraw = false, and you go to the vb debugging session, and restore your
    'app, the text is vanished!
    Me.AutoRedraw = True
    'create a ref to the wia commondialog.
    Set objWia = New WIA.CommonDialog
    'this makes sure a camera is selected, and no scanner.
    'the true part ALWAYS displays the dialog (normally omitted if only one dev is found)
    Set d = objWia.ShowSelectDevice(CameraDeviceType, True)
   
   
    'for this example, the files are downloaded every time to the
    'directory "downloaded images" in the project dir
    'you could check wether the image exists, before downloading it
    'so only the files that don't exist locally are transferred
   
    If Dir(App.Path & "\downloaded images\", vbDirectory) = "" Then
        'dir doesnt exist, create it
        MkDir App.Path & "\downloaded images\"
    Else
        'make sure the dir is empty!
        Dim tmpPath As String
       
               
        tmpPath = Dir(App.Path & "\downloaded images\", vbNormal + vbReadOnly)
        While Len(tmpPath) > 0
            Kill App.Path & "\downloaded images\" & tmpPath
            tmpPath = Dir()
        Wend
    End If
   
   
    Me.Show
    lCounter = 0
    Me.Caption = "Examining file " & lCounter & " of " & d.Items.Count & " please wait..."
    'loop trough all (root) items in the camera device
    For Each itm In d.Items
        Dim f As Properties
        Set f = itm.Properties
        Dim str As String
       
        'optional, display progress bar here
        'the total amount of pictures is stored in d.items.count
        lCounter = lCounter + 1
        Me.Caption = "Examining file " & lCounter & " of " & d.Items.Count & " please wait..."
        'give vb time to process its messages (else the app appears as not responding)
        DoEvents
       
        'is the item a file? (could also be a dir or so)
        If (f.Item("Item Flags") And ImageItemFlag) = ImageItemFlag Then
            'for reference:
           
            'f.Item("Full Item Name")       -> "0002\Root\IMG_1141"
            'f.Item("Item Name")            -> "IMG_1141"
            'f.Item("Filename extension")   -> "JPG"
           
           
           
            'check if the file exist locally (create your own function!)
            'If f.Item("Item Name") <> "nameoflocalfile" Then
           
                       
                'download the file to a temp buffer
                Set imgpic = itm.Transfer
                'store the file name and extension and app.path in a string,
                'so you can use it to perform more operations on it
                str = App.Path & "\downloaded images\" & f.Item("Item Name") & "." & imgpic.FileExtension
               
                'save the file (default format is used, bmp stays bmp, jpg stays jpg
                'this is why we switched to version 2.0 of the lib!
                imgpic.SaveFile str
               
                'you can process the image further here, it is now stored on your pc!
                '(add it to a list, to an picturebox, or whatever!)
               
            'End If
        End If
    Next
    Me.Caption = "finished, thanks for waiting!"
End Sub

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
scbdpmAuthor Commented:
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.......???)
0
scbdpmAuthor Commented:
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.