scbdpm
asked on
WIA copying then deleting a photo
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.....
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.....
ASKER
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???
colRemove.Add itm.ItemId
could VB be 'funky' in trying to add the item to a collection???
ASKER
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?
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?
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"
ASKER
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?
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?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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(Ca
'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