Solved

Accessing my digital camera

Posted on 2007-04-01
35
1,215 Views
Last Modified: 2009-12-16
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......
0
Comment
Question by:scbdpm
  • 20
  • 15
35 Comments
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility

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

Author Comment

by:scbdpm
Comment Utility
but it doesn't show up with a drive letter......
0
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility

so how can you view it in explorer then?
0
 

Author Comment

by:scbdpm
Comment Utility
it is listed under 'My Computer' as the name of the camera: Canon A620 ...
0
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility

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
 

Author Comment

by:scbdpm
Comment Utility
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
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility

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
 

Author Comment

by:scbdpm
Comment Utility
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
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility


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
 

Author Comment

by:scbdpm
Comment Utility
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
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility

no, that was not what i was looking for.


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






0
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility

one more thing that pops up,


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

at what category is the device listed?
0
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility
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
 

Author Comment

by:scbdpm
Comment Utility
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
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility

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
 

Author Comment

by:scbdpm
Comment Utility
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
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility

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

0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility
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
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility
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
 

Author Comment

by:scbdpm
Comment Utility
Same thing, I can't get past the line:   Set objRootItem = objWia.Create(objDeviceInfo)
even with the change
0
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility

did you try the all new code?
0
 

Author Comment

by:scbdpm
Comment Utility
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
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility
nope it isnt


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

Author Comment

by:scbdpm
Comment Utility
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
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility


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
 

Author Comment

by:scbdpm
Comment Utility
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
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility

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
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility
0
 

Author Comment

by:scbdpm
Comment Utility
I can't thank you enough.

0
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility

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
 

Author Comment

by:scbdpm
Comment Utility
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
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
Comment Utility

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
 
LVL 13

Accepted Solution

by:
Mark_FreeSoftware earned 500 total points
Comment Utility

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
 

Author Comment

by:scbdpm
Comment Utility
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
 

Author Comment

by:scbdpm
Comment Utility
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

6 Experts available now in Live!

Get 1:1 Help Now