View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Arran Arran is offline
external usenet poster
 
Posts: 50
Default Rename Excel File

Hi,

I was hoping that someone could help me with the "Name" Function in VBA as I
cannot get it to work.
I have got the following code that allows the user to open a workbook (a
form that has been created/completed in a workbook), it then copies certain
cells from the "Form" to the "Data Base".

What I would like to happen next is that when a workbook has been processed
it renames the work book to filename & "Imported" but deletes the original
file.

Option Explicit
Sub importdata()
Dim sFilename As Variant 'could be a boolean (False)
'Dim A As Long
Dim MLRow As Long
Dim NewFormWkbk As Workbook
Dim NewFormWks As Worksheet
Dim DBWks As Worksheet

sFilename = Application.GetOpenFilename

If sFilename = False Then
Exit Sub
End If

Set NewFormWkbk = Workbooks.Open(Filename:=sFilename)

Set NewFormWks = Nothing
On Error Resume Next
Set NewFormWks = NewFormWkbk.Worksheets("New Contract Set Up Form")
On Error GoTo 0

If NewFormWks Is Nothing Then
MsgBox "No sheet named: New Contract Set Up Form"
Exit Sub
End If

Set DBWks = ThisWorkbook.Worksheets("Data Base")

MLRow = 4 'MasterList Start Row

Do Until ThisWorkbook.Sheets("Data Base").Cells(MLRow, 2) = ""
If DBWks.Cells(MLRow, 3).Value = NewFormWks.Cells(7, 4).Value Then
DBWks.Cells(MLRow, 2).Value = NewFormWks.Cells(5, 7).Value
'Division
DBWks.Cells(MLRow, 3).Value = NewFormWks.Cells(7, 4).Value
'Contract No

MLRow = 5
Exit Do
End If
MLRow = MLRow + 1
If DBWks.Cells(MLRow, 3).Value = "" Then
DBWks.Cells(MLRow, 2).Value = NewFormWks.Cells(5, 7).Value 'Division
DBWks.Cells(MLRow, 3).Value = NewFormWks.Cells(7, 4).Value 'Contract
No

End If
Loop

Dim OldName As String
Dim OldPath As String
Dim NewName As String

OldPath = NewFormWkbk.Path & "\"
OldName = NewFormWkbk.Name

NewName = OldPath & Left(OldName, Len(OldName) - 4) & "- Imported.xls"
ActiveWorkbook.SaveAs NewName

Kill ("OldPath & Left(OldName, Len(OldName) - 4)")
End Sub

Any help again will be greatly appreciated.

Many thanks