Seeking Help from CodeWarriors strDestinationPath 1

[BubbaJean]

The code below copies and paste drawing from one location to another. e.g.
From: C:\filename1.pdf
To: K:\filename1.pdf
but the field storing this information, still shows the old path C:\filename1.pdf
how do I get the field to store the new path location K:\filename1.pdf?


Option Compare Database

Private Const FO_COPY = &H2

Private Const FOF_SIMPLEPROGRESS = &H100

Private Const FOF_NOCONFIRMATION = &H10

Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long

Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Sub cmdFileOpen_Click()

' Test the CommonDlg class' FileOpen common dialog.

Dim cdl As CommonDlg
Set cdl = New CommonDlg

cdl.hWndOwner = Me.hWnd
cdl.CancelError = True

On Error GoTo HandleErrors

' Set three pairs of values for the Filter.
cdl.Filter = _
"Adobe Acrobat Document (*.pdf)|" & _
"*.pdf|" & _
"Database files (*.mdb, *.mde, *.mda)|" & _
"*.mdb;*.mde;*.mda|" & _
"All files (*.*)|" & _
"*.*"

' Select filter 1 (DataShete files) when
' the dialog opens.
cdl.FilterIndex = 1

' Indicate that you want to use a callback function,
' change back to the original directory when
' you're done, and require that the selected
' file actually exist.
cdl.OpenFlags = cdlOFNEnableHook Or _
cdlOFNNoChangeDir Or cdlOFNFileMustExist

' Select the callback function.
cdl.CallBack = adhFnPtrToLong(AddressOf GFNCallback)

' Set up miscellaneous properties.
cdl.InitDir = "C:\"
cdl.FileName = "autoexec.pdf"
cdl.DefaultExt = "pdf"

' Open the file open dialog box,
' and wait for it to be dismissed.
cdl.ShowOpen

' Retrieve the selected file na
txtFileOpen = cdl.FileName

' Check the OpenFlags (or Flags) property to
' see if the selected extension is different than
' the default extension.
If (cdl.OpenFlags And _
cdlOFNExtensionDifferent) <> 0 Then
MsgBox &quot;You chose a different extension!&quot;
End If

ExitHere:
Set cdl = Nothing
Exit Sub

HandleErrors:
Select Case Err.Number
Case cdlCancel
' Cancelled!
Resume ExitHere
Case Else
MsgBox &quot;Error: &quot; & Err.Description & _
&quot;(&quot; & Err.Number & &quot&quot;
End Select
Resume ExitHere
End Sub

Private Sub cmdMoveFiles_Click()

'On Error GoTo ErrorX
Dim x As SHFILEOPSTRUCT
'***********DS_1X*************************
Dim StrFile As String
If IsNull(Me.DS_X1.Value) = False Then
StrFile = Me.DS_X1.Value

'Copies the file in textbox DS_X1
'String function to get rid of the &quot;#&quot; from the hyperlink.
x.pFrom = Mid(StrFile, 2, Len(StrFile) - 2)
'Pastes the file to stated location.
x.pTo = &quot;k:\&quot;
x.fFlags = FOF_NOCONFIRMATION
x.wFunc = FO_COPY
SHFileOperation x
MsgBox &quot;Copy Complete.&quot;, vbOKOnly
End If

'***********DS_2X*************************

Dim StrFile2 As String
If IsNull(Me.DS_X2.Value) = False Then
StrFile2 = Me.DS_X2.Value

'Copies the file in textbox DS_X2
'String function to get rid of the &quot;#&quot; from the hyperlink.
x.pFrom = Mid(StrFile2, 2, Len(StrFile2) - 2)

'Pastes the file to stated location.
x.pTo = &quot;k:\&quot;
x.fFlags = FOF_NOCONFIRMATION
x.wFunc = FO_COPY
SHFileOperation x
MsgBox &quot;File 2 Copy Complete.&quot;, vbOKOnly
End If

'***********DS_3X*************************
Dim StrFile3 As String
If IsNull(Me.DS_X3.Value) = False Then
StrFile3 = Me.DS_X3.Value

'Copies the file in textbox DS_X3
'String function to get rid of the &quot;#&quot; from the hyperlink.
x.pFrom = Mid(StrFile3, 2, Len(StrFile3) - 2)
'Pastes the file to stated location.
x.pTo = &quot;k:\&quot;
'x.fFlags = FOF_NOCONFIRMATION
x.wFunc = FO_COPY
SHFileOperation x
MsgBox &quot;File 3 Copy Complete.&quot;, vbOKOnly
End If
'***********DS_4X*************************
Dim StrFile4 As String



If IsNull(Me.DS_X4.Value) = False Then
StrFile4 = Me.DS_X4.Value

'Copies the file in textbox DS_X4
'String function to get rid of the &quot;#&quot; from the hyperlink.
x.pFrom = Mid(StrFile4, 2, Len(StrFile4) - 2)
'Pastes the file to stated location.
x.pTo = &quot;k:\&quot;
'x.fFlags = FOF_NOCONFIRMATION
x.wFunc = FO_COPY
SHFileOperation x
MsgBox &quot;File 4 Copy Complete.&quot;, vbOKOnly
End If
End Sub

 

[Frink]

Hallo,

In the code for DS_1X, before the SHFileOperation x, add the line:
Me!DS_X1 = x.pTo & Dir$(x.pFrom)

That might work...
It's a bit flaky as there's no error handling,
but it is a Friday

- Frink

 

[BubbaJean]

Thanks Frink, that did the Trick!!