Code for Select a file and save it in a different location

[Oggy]

Hi

I am trying to write a code that allows me to select a file and save
it in a different location, and then delete the orginal file. I have
the following code, that does not work, i think i may be over
complicating it. Please Help!




Sub remove FileName()
Dim Filt As String
Dim FilterIndex As Integer
Dim FileName As Variant
Dim Title As String

' Set up list of file filters
Filt = "Text Files (*.txt),*.txt," & _
"Lotus Files (*.prn),*.prn," & _
"Comma Separated Files (*.csv),*.csv," & _
"ASCII Files (*.asc),*.asc," & _
"All Files (*.*),*.*"

' Display *.* by default
FilterIndex = 5

' Set the dialog box caption
Title = "Select a File to move"


' set directory
Chdir H:\OPEN ORDERS

' Get the file name
FileName = Application.GetOpenFilename _
(FileFilter:=Filt, _
FilterIndex:=FilterIndex, _
Title:=Title)

' Exit if dialog box canceled
If FileName = False Then
MsgBox "No file was selected."
Exit Sub
End If
WorkBook.Open filename: .selecteditems(1)

If Val(Application.Version) < 10 Then
MsgBox "This requires Excel 2002 or later.", vbCritical
Exit Sub
End If
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a location for the PO"
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Canceled"
Else
WorkBook.SaveAs .SelectedItems(1)
End If
End With


Chdir H:\OPEN ORDERS

Kill .selecteditems(1)


End Sub

 

[Guest]

Oggy,

try this slightly modified code.


Sub removeFileName()
Dim Filt As String
Dim FilterIndex As Integer
Dim FileName As Variant
Dim Title As String
Dim strSaveAsFile As String

' Set up list of file filters
Filt = "Text Files (*.txt),*.txt," & _
"Lotus Files (*.prn),*.prn," & _
"Comma Separated Files (*.csv),*.csv," & _
"ASCII Files (*.asc),*.asc," & _
"All Files (*.*),*.*"

' Display *.* by default
FilterIndex = 5

' Set the dialog box caption
Title = "Select a File to move"

' set directory
ChDir "D:\TEMP"

' Get the file name
FileName = Application.GetOpenFilename _
(FileFilter:=Filt, _
FilterIndex:=FilterIndex, _
Title:=Title)

' Exit if dialog box canceled
If FileName = False Then
MsgBox "No file was selected."
Exit Sub
End If

If Val(Application.Version) < 10 Then
MsgBox "This requires Excel 2002 or later.", vbCritical
Exit Sub
End If

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a location for the PO"
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Canceled"
Else
'Move the file
strSaveAsFile = StrReverse(FileName)
strSaveAsFile = StrReverse(Mid(strSaveAsFile, 1, InStr(1,
strSaveAsFile, "\")))
Name FileName As .SelectedItems(1) & strSaveAsFile
End If
End With

End Sub

 

[Oggy]

Thank you this worked perfect

Regards

Oggy