Solved: Copy File from DialogFileOpener

[Imdabaum]

:banghead: I am trying to create an easy way to upload an image. All photos go into a folder called Photos, pretty cut and dry. I then created a tblProjectPhotos with ProjectID, Caption, Location as fields. I have got code that writes the (supposed) location into the record along with the ProjectID that corresponds with the image. Does anyone know how I can copy an image from local machine to a Network address?

http://msdn2.microsoft.com/en-us/library/bwfbss93.aspx
"The path is not valid for one of the following reasons: it is a zero-length string, it contains only white space, it contains invalid characters, or it is a device path (starts with \\.\ (file://\\.\)).


Private Sub btnAdd_Click()
On Error GoTo Err_btnAdd_Click
Dim strAddress As String
Dim db As Database
Dim rst As Recordset
Dim txtTest As String
Dim I As Integer
Dim txtletter As String
Dim intLength As Integer
Dim SourceFile As String
Dim DestinationFile As String
Dim intImage As Integer ' 0=NO, no images, -1=YES, has images
Dim strPath As String ' Directory for all images
Dim strProjFile As String ' Directory with isolated images
Dim strImagePath As String ' Path comes from tblImagePath
Dim lngLen As Long ' Length of strImagePath
Dim Counter As Long
Dim sngStart As Single ' Used to calc time
Dim sngEnd As Single
Dim sngElapsed As Single

strImagePath = DLookup("[ImagePath]", "tblImagePath") ' Path to ISOLATED images from tblImagePath
lngLen = Len(strImagePath)

For I = lngLen To 1 Step -1 ' strPath = where ALL images are located
txtletter = Mid(strImagePath, I, 1)
If txtletter = "\" Then
Exit For
End If
Next I
strPath = Left(strImagePath, I - 1)

Set db = CurrentDb
' Set rst = db.OpenRecordset("tblPropertiesPhoto", dbOpenTable)
Set rst = db.OpenRecordset("tblPropertiesPhoto", dbOpenDynaset) ' SMRF 14746 - Ruth Radmall - 1 Apr 2002

strPropFile = strImagePath & "\" & Forms!frmPropertiesNew!PropertyNumber & "\* " 'order by propNum
' need to test if strPropFile already exists... if not create it, or prompt for approval to create
'
If Dir(strPropFile) = "" Then ' Test if already have isolated images
'sngStart = Timer ' Get start time.
' Why are we killing all .jpg file types? In strImagePath
'Kill strImagePath & "\*.jpg"
SourceFile = strPath & "\" & Forms!frmPropertiesNew!PropertyNumber & "* "
DestinationFile = strImagePath & "\"
intImage = CopyFile(SourceFile, DestinationFile) ' CopyFile in modMisc

' Wait about 6.8 seconds for CopyFile to finish (runs asynchronously)
DoCmd.Hourglass True
Counter = 0
Do While Counter < 15000000
Counter = Counter + 1 ' Increment Counter.
' If Counter = 14999999 Then ' If condition is True, and if it is false it exits one ms later? Point of this?
' Exit Do ' Exit loop.
End If
Loop
DoCmd.Hourglass False

' sngEnd = Timer ' Get end time.
' sngElapsed = Format(sngEnd - sngStart, "Fixed") ' Elapsed time.
' MsgBox ("It took " & sngElapsed _
& " seconds to run.")

End If

strAddress = GetOpenFile_TSB(strImagePath & "\", "Images for Selected Property") ' WORKS

If strAddress <> "" Then
Me.Image1.Picture = strAddress
txtTest = Right(strAddress, 74) ' SubjectName = 70 char + ".jpg"
For I = 74 To 1 Step -1
txtletter = Mid(txtTest, I, 1)
If txtletter = "\" Then
Exit For
End If
intLength = intLength + 1
Next I
Me.txtSubject = Mid(txtTest, I + 1, intLength - 4) ' Extracted Subject Name

With rst
.AddNew
!ProjectID = Forms.frmProjectNew.ID
!Caption = txtSubject
!location = strPath & "\" & txtSubject & ".jpg"
.Update
End With
UpdateList
End If

Exit_btnAdd_Click:
Exit Sub

Err_btnAdd_Click:
If Err.Number = 53 Then ' File not found
Resume Next
Else
MsgBox Err.Number & " " & Err.Description
Resume Exit_btnAdd_Click
End If
End Sub

The CopyFile Function goes something like this:
Function CopyFile(SourceFile As String, Destfile As String) As Integer
'************************************************************************** **********************
'PURPOSE: Copy a file on disk from one location to another.
'Accepts: The name of the source file and destination file.
'RETURNS: 0=NO, -1=YES
'LOCATED: modMisc
'************************************************************************** **********************
Dim copyString As String
CopyFile = 0 ' NO
If Dir(SourceFile) = "" Then
MsgBox Chr(34) & Right(SourceFile, 10) & Chr(34) & _
" There are no images for this property."

Else
SourceFile = Chr(34) & SourceFile & Chr(34)
Destfile = Chr(34) & Destfile & Chr(34)
copyString = "CMD.EXE /C Copy " & SourceFile & _
" " & Destfile
Call Shell(copyString, 0)
CopyFile = -1 ' YES
End If
End Function

[OBP]

I have a routine, which I did not write, but works well that allows a user to browse to a Folder and when they click it, the folder and it's path are placed in a field.
Would something like that do what you want?
The folder and path name are all that is necessary to put a photo in a form or report.

[Imdabaum]

Absolutely. That is what I was trying to work into mine i got the textboxes built into the form just trying to figure out how to save the information in the txtFields. I found a lot of Articles and things saying it was as easy as just inserting the following code:

FileCopy MyFile.doc, D:\
This doesn't seem to work. I attempted with the similar code
FileCopy Water lillies.jpg, L:\Photos\Projects
Since I have seen that solution posted so much I am wondering if it is an issue with image files. Maybe they need something more specific to handle them?

[Imdabaum]

Well I figured out what was going on. I needed the name of the file at the end of the destination source. If you see this Thread and have questions you can email me from the forum. I'll be glad to explain it... umm not sure if anyone wants the solution here if I figured out my own problem.... Do you usually post the solution you came up with if it a solution for you own post?

[boneKrusher]

Posting the solution and mark the thread solved is always a good idea.

Thanks

[Imdabaum]

Well I guess I need to post my solution then. Here you go everyone. This is the routine I changed:
Dim db As Database
Dim rst As Recordset
Dim txtTest As String
Dim txtletter As String
Dim I As Integer
Dim intLength As Integer
Dim lngLen As Long
Dim SourceFile As String
Dim DFile As String
Dim propFolder As String
Dim fName As String
Dim strImagePath As String
Dim strPath As String
Dim strPropFile As String
Dim intImage As Integer '0 if Image copy failed, 1 if Image copy succeeded

Set db = CurrentDb
Set rst = db.OpenRecordset("tblProjectPhoto", dbOpenDynaset)
propFolder = [Forms]![frmProjectNew]![projectNumber] 'folder name= Project Number
strImagePath = DLookup("[ImagePath]", "tblImagePath") 'This could be hardcoded, but wasn't originally and didn't change it.
lngLen = Len(strImagePath)

For I = lngLen To 1 Step -1 'strPath = where ALL project folders are located
txtletter = Mid(strImagePath, I, 1)
If txtletter = "\" Then
Exit For
End If
Next I
strPath = Left(strImagePath, I - 1)

SourceFile = GetOpenFile_TSB(strPath & "\", "Images for Selected Project")
'MsgBox SourceFile, vbOKOnly, "Directory"
strProjFile = strPath & "\" & projFolder & "\* "
DFile = strPath & "\" & projFolder & "\"
If SourceFile <> "" Then
txtTest = Right(SourceFile, Len(SourceFile)) ' SubjectName = 70 char + ".jpg"
For I = Len(SourceFile) To 1 Step -1
txtletter = Mid(txtTest, I, 1)
If txtletter = "\" Then
Exit For
End If
intLength = intLength + 1
Next I
fName = Mid(txtTest, I + 1, intLength - 4) ' Extracted Subject Name
End If
If Dir(strProjFile) = "" Then 'If the directory doesn't exist, we make it.
MsgBox "Directory Not Found", vbCritical, "Find Directory"
MkDir (DFile)
End If
'MsgBox "Directory Found", vbOKOnly, "Find Directory"
fName = InputBox("Would you like to rename the file?", "File Name", fName)
'FileCopy SourceFile, DFile & "\" & fName & ".jpg"
intImage = CopyFile(SourceFile, DFile, projFolder, fName)
If intImage = 1 Then
Me.txtSubject = fName
With rst
.AddNew
!ProjectID = Forms.frmProjectNew.ID
!Caption = txtSubject
!location = DFile & fName & ".jpg"
.Update
Me.Image1.Picture = SourceFile
End With
UpdateList
End If
Exit_btnAdd_Click:
Exit Sub
Err_btnAdd_Click:
If Err.Number = 53 Then
Resume Next
Else
MsgBox Err.Number & ": " & Err.Description
Resume Exit_btnAdd_Click
End If
End Sub

The CopyFile Function was changed to the following:
Function CopyFile(SourceFile As String, Destfile As String, FolderName As String, fileName As String) As Integer

Dim copyString As String
Dim strFile As String
CopyFile = 0 ' NO
strFile = fileName & ".jpg"
If Dir(Destfile & strFile) = "" Then
CopyFile = 1
GoTo CopyIt
Else
If MsgBox("Do you want to overwrite the image" & strFile, vbYesNo, "File Exists") = vbYes Then
CopyFile = 2
GoTo CopyIt
End If
End If
CopyIt:
copyString = Destfile & strFile
'copyString = "CMD.EXE /C Copy " & SourceFile & " " & Destfile
'Call Shell(copyString, 0)
FileCopy SourceFile, copyString
End Function