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

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


--
Hope that helps.

Vergel Adriano


"Oggy" wrote:



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

Thank you this worked perfect

Regards

Oggy






On 22 Apr, 13:26, Vergel Adriano
wrote:
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

--
Hope that helps.

Vergel Adriano



"Oggy" wrote:

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- Hide quoted text -

- Show quoted text -