Below is the code that many of you helped me, it is designed to do the following
Take drawings from directory C:\ and Transfer them to Dir F:\ The code copies and paste the drawing and list the new name e.g. FROM: C:\Drawing1.pdf To: F:\Drawing1.pdf
What dosn't work is, when the user click on the new path (F:\Drawing1.pdf)nothing happens what should happen is the drawing opens. Please help I'm ready to give up on VB altogether
Option Compare Database
'**************START CODE*****************************
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
'**************END CODE*****************************
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 "You chose a different extension!"
End If
ExitHere:
Set cdl = Nothing
Exit Sub
HandleErrors:
Select Case Err.Number
Case cdlCancel
' Cancelled!
Resume ExitHere
Case Else
MsgBox "Error: " & Err.Description & _
"(" & Err.Number & "
"
End Select
Resume ExitHere
End Sub
Private Sub cmdMoveFiles_Click()
On Error GoTo ErrorX
Dim x As SHFILEOPSTRUCT
Dim StrFile As String
StrFile = Me.DS_X1.Value
'Copies the file in textbox DS_X1
'String function to get rid of the "#" from the hyperlink.
x.pFrom = Mid(StrFile, 2, Len(StrFile) - 2)
'Pastes the file to stated location.
x.pTo = "F:\"
x.fFlags = FOF_NOCONFIRMATION
x.wFunc = FO_COPY
'In the code for DS_1X, before the SHFileOperation x, add the line:
Me!DS_X1 = x.pTo & Dir$(x.pFrom)
SHFileOperation x
MsgBox "Copy Complete.", vbOKOnly
Exit Sub
ErrorX:
MsgBox "Error #:" & Err.Number & " " & Err.Description & vbCrLf _
& "Copy Failed."
End Sub
Take drawings from directory C:\ and Transfer them to Dir F:\ The code copies and paste the drawing and list the new name e.g. FROM: C:\Drawing1.pdf To: F:\Drawing1.pdf
What dosn't work is, when the user click on the new path (F:\Drawing1.pdf)nothing happens what should happen is the drawing opens. Please help I'm ready to give up on VB altogether
Option Compare Database
'**************START CODE*****************************
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
'**************END CODE*****************************
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 "You chose a different extension!"
End If
ExitHere:
Set cdl = Nothing
Exit Sub
HandleErrors:
Select Case Err.Number
Case cdlCancel
' Cancelled!
Resume ExitHere
Case Else
MsgBox "Error: " & Err.Description & _
"(" & Err.Number & "
End Select
Resume ExitHere
End Sub
Private Sub cmdMoveFiles_Click()
On Error GoTo ErrorX
Dim x As SHFILEOPSTRUCT
Dim StrFile As String
StrFile = Me.DS_X1.Value
'Copies the file in textbox DS_X1
'String function to get rid of the "#" from the hyperlink.
x.pFrom = Mid(StrFile, 2, Len(StrFile) - 2)
'Pastes the file to stated location.
x.pTo = "F:\"
x.fFlags = FOF_NOCONFIRMATION
x.wFunc = FO_COPY
'In the code for DS_1X, before the SHFileOperation x, add the line:
Me!DS_X1 = x.pTo & Dir$(x.pFrom)
SHFileOperation x
MsgBox "Copy Complete.", vbOKOnly
Exit Sub
ErrorX:
MsgBox "Error #:" & Err.Number & " " & Err.Description & vbCrLf _
& "Copy Failed."
End Sub