PDA

View Full Version : rename excel files using text in it



amcbarnes
01-27-2007, 09:50 PM
I download "tickets" everyday that are email attached excel files and I am using code inside excel to save these files to a folder for use on the job. I am currently using this code:


Public Sub findfsr()
Dim ns As Outlook.Namespace
Dim Inbox As Outlook.MAPIFolder
Dim SubFolder As Outlook.MAPIFolder
Dim Item As Object
Dim Atmt As Outlook.Attachment
Dim FileName As String
Dim i As Integer
Set ns = Outlook.GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders("Clearview")
i = 0
If SubFolder.Items.Count = 0 Then
MsgBox "There are no FSR's in the Clearview Folder", vbInformation, _
"Nothing Found"
Exit Sub
End If
For Each Item In SubFolder.Items
For Each Atmt In Item.Attachments
FileName = "C:\FSR\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
Next Atmt
Next Item
If i > 0 Then
MsgBox "Found " & i & " FSR's.", vbInformation, "Finished!"
Else
MsgBox "No FSR's Found.", vbInformation, _
"Finished!"
End If
findfsr_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Set app01 = Nothing
Exit Sub
findfsr_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: findfsr" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume findfsr_exit
End Sub


The problem is these filenames are confusing and there are many files that I have difficulty sorting through manually. I want to rename these with names that are easy to recognize and are job specific. an easy name for each file is contained in a specific cell already in each file, but I don't know how to get that cell reference to be used as the rename. any help would be greatly appreciated.

Jacob Hilderbrand
01-27-2007, 09:57 PM
Your file name is here:


FileName = "C:\FSR\" & Atmt.FileName



If you wanted to use a cell value you could do something like this:


FileName = "C:\FSR\" & Range("A1").Text & " - " & Atmt.FileName



For example.

amcbarnes
01-28-2007, 12:36 PM
This almost works, but I have around 100 files that are being written over each other with one cell value on the active sheet, or so I think. Nothing is actually making it to my FSR folder now. I've change only the code as seen below. What I need to get the cell value from cell BF20 from Each sheet being saved and then save it as its own individual file for use later in the program. I guess I have to activate each attached workbook and then reference the cell and then close it.

For Each Item In SubFolder.Items
For Each Atmt In Item.Attachments
FileName = "C:\FSR\" & Range(BF20).Text
i = i + 1
Next Atmt
Next Item

mdmackillop
01-28-2007, 01:04 PM
try
For Each Item In SubFolder.Items
For Each Atmt In Item.Attachments
i = i + 1
Fname = "C:\FSR\" & Split(Atmt.Filename, ".")(0) & " - " _
& Format(i, "000") & Split(Atmt.Filename, ".")(1)
Atmt.SaveAsFile Fname
Next Atmt
Next Item

mdmackillop
01-28-2007, 01:20 PM
This should read the value in each file in Sheet1 cell BF20 and rename the file according to that value.

Sub ProcessFiles()
Dim MyPath As String, MyName As String, SheetName As String
Dim SheetVal As String
MyPath = "C:\FSR\"
MyName = Dir("C:\FSR\*.xls")
Do While MyName <> ""
SheetName = "Sheet1"
SheetVal = GetData(MyPath, MyName, SheetName, "$BF$20")
Name MyName As MyPath & SheetVal & .xls
MyName = Dir
Loop
End Sub
Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
Range(Address).Range("A1").Address(, , xlR1C1)
Debug.Print Data
GetData = ExecuteExcel4Macro(Data)
End Function

amcbarnes
01-29-2007, 03:19 PM
no good. I'm getting a compile error and the .xls is highlighted in the line:

Name MyName As MyPath & SheetVal & .xls

I deleted the & .xls and recieved a type mismatch on:

SheetVal = GetData(MyPath, MyName, SheetName, "$BF$20")

I don't know where to go from there.

mdmackillop
01-29-2007, 03:34 PM
Can you post one of your imported files? Remove any sensitive data first.
To post a file, use Manage Attachments in the Go Advanced section.

amcbarnes
01-29-2007, 03:45 PM
Here is one of 102 files

mdmackillop
01-29-2007, 03:59 PM
Try this revision. It assumes the sheet name in each imported file is "rpc_fsr_report"

Option Compare Text

Sub ProcessFiles()
Dim MyPath As String, MyName As String, SheetName As String
Dim SheetVal As String
MyPath = "C:\FSR\"
MyName = Dir("C:\FSR\*.xls")
Do While MyName <> ""
SheetName = "rpc_fsr_report"
SheetVal = GetData(MyPath, MyName, SheetName, "$BF$20")
Name MyName As MyPath & SheetVal & ".xls"
MyName = Dir
Loop
End Sub
Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
Range(Address).Range("A1").Address(, , xlR1C1)
Debug.Print Data
GetData = ExecuteExcel4Macro(Data)
End Function

amcbarnes
01-29-2007, 04:04 PM
runtime error '1004':

method 'ExecuteExcel4Macro' of object '_global' failed

Highlited the line:

GetData = ExecuteExcel4Macro(Data)

mdmackillop
01-29-2007, 04:31 PM
If your sheet names are not consistent, try the method given here.
http://www.erlandsendata.no/english/index.php?d=envbadacimportwbado

mdmackillop
01-29-2007, 04:42 PM
runtime error '1004':

method 'ExecuteExcel4Macro' of object '_global' failed

Highlited the line:

GetData = ExecuteExcel4Macro(Data)

What string are you getting for Data?
Are the Path, Sheet etc. names all correct?

amcbarnes
01-29-2007, 05:06 PM
This is what I get in my Immediate window:

'C:\FSR\[rad0081Crpc_fsr_report.xls]rpc_fsr_report'!R20C58

mdmackillop
01-29-2007, 05:14 PM
I don't see a problem with that.

Edit
Are you using Option Compare Text?

amcbarnes
01-29-2007, 05:33 PM
This is the exact code I'm using:
Option Compare Text

Sub ProcessFiles()
Dim MyPath As String, MyName As String, SheetName As String
Dim SheetVal As String
MyPath = "C:\FSR\"
MyName = Dir("C:\FSR\*.xls")
Do While MyName <> ""
SheetName = "rpc_fsr_report"
SheetVal = GetData(MyPath, MyName, SheetName, "$BF$20")
Name MyName As MyPath & SheetVal & ".xls"
MyName = Dir
Loop
End Sub
Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
Range(Address).Range("A1").Address(, , xlR1C1)
Debug.Print Data
GetData = ExecuteExcel4Macro(Data)
End Function


I'm assuming that it doesn't matter if this is in a module?