Solved

WIA copying then deleting a photo

Posted on 2007-04-04
6
969 Views
Last Modified: 2010-08-05
I have received code that will delete the images off my digital camera using WIA.
I also have code that will copy to a HDD.

Is there someone who could help me to put these two together- i.e. within the procedure for copying the photo, an if statement (based on check box) determines if the photo should be copied then deleted...

I got this code from another post:
For Each Itm In dev.Items
        Dim f As Properties
        Set f = Itm.Properties
        Dim str As String
        'is the item a file? (could also be a dir or so)
        If (f.Item("Item Flags") And ImageItemFlag) = ImageItemFlag Then
         
            'check if the file exist locally (create your own function!)
            'If f.Item("Item Name") <> "nameoflocalfile" Then

                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 Itm

what I would like to do is have the if chkdelete statement somewhere here so that the photo is copied then deleted.....

0
Comment
Question by:scbdpm
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 3
6 Comments
 
LVL 13

Expert Comment

by:Mark_FreeSoftware
ID: 18858965

after putting my 2 examples together you would get somthing like this:



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
Dim colRemove As Collection
Dim bDeleteAfterDownload As Boolean


    'instead of this, do a nice check for a checkbox
    bDeleteAfterDownload = True
   

    '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
            If bDeleteAfterDownload = True Then
                colRemove.Add itm.ItemID
            End If
           
           
                       
                '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
   
    If bDeleteAfterDownload = True Then
    Dim n As Long, i As Long
        For n = colRemove.Count - 1 To 0 Step -1
            For i = 1 To d.Items.Count
            If d.Items(i).ItemID = colRemove.Item(i) Then
                'Some Cameras don't support deleting pictures
                On Error Resume Next
                d.Items.Remove i
                If Err.Number <> 0 Then
                    MsgBox Err.Description
                    Err.Clear
                End If
                On Error GoTo 0
                Exit For
            End If
         Next
           
        Next
    End If
   
   
    Me.Caption = "finished, thanks for waiting!"
End Sub

0
 

Author Comment

by:scbdpm
ID: 18861563
looks like what I need, however, I am getting an error on the line:

colRemove.Add itm.ItemId

could VB be 'funky' in trying to add the item to a collection???
0
 

Author Comment

by:scbdpm
ID: 18861642
actually seemed to solve this problem with
set colRemove = New Collection.

But having problems with:
 If bDeleteAfterDownload = True Then
    Dim n As Long, i As Long
        For n = colRemove.Count - 1 To 0 Step -1
            For i = 1 To d.Items.Count
            If d.Items(i).ItemId = colRemove.Item(i) Then
                'Some Cameras don't support deleting pictures
                On Error Resume Next
                d.Items.Remove i
                If Err.Number <> 0 Then
                    MsgBox Err.Description
                    Err.Clear
                End If
                On Error GoTo 0
                Exit For
            End If
         Next
           
        Next
    End If

If d.Items(i).ItemId = colRemove.Item(i) Then
it is this line. Is it because the SD card I am using also contains a folder called "Misc' that my camera automatically creates?
0
Creating Instructional Tutorials  

For Any Use & On Any Platform

Contextual Guidance at the moment of need helps your employees/users adopt software o& achieve even the most complex tasks instantly. Boost knowledge retention, software adoption & employee engagement with easy solution.

 
LVL 13

Expert Comment

by:Mark_FreeSoftware
ID: 18863060

my apologies for the errors in the code, couldnt test it yesterday

add this line between "For i = 1 To d.Items.Count" and "If d.Items(i).ItemId = colRemove.Item(i) Then"

If (f.Item("Item Flags") And ImageItemFlag) = ImageItemFlag Then

and add another "end if" between the "end if" and "next"
0
 

Author Comment

by:scbdpm
ID: 18863358
I now have this:
 For i = 1 To d.Items.Count
                If (f.Item("Item Flags") And ImageItemFlag) = ImageItemFlag Then
                    If d.Items(i).ItemId = colRemove.Item(i) Then

but for some reason the line "If (f.Item("Item Flags") And ImageItemFlag) = ImageItemFlag Then" is still true when it is on the "MISC" folder... strrange since it is ok in the download code....

any other suggestions?
0
 
LVL 13

Accepted Solution

by:
Mark_FreeSoftware earned 500 total points
ID: 18863417
change that
f.Item("Item Flags")
to
d.Items(i).Properties.Item ("Item Flags")


0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
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…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

691 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