Excel 2003: Add worksheet with variable as worksheet name?

[LolaM]

OK, folks... some more VBA help needed please!!!

I need to create a macro which will prompt the user to select a PDF file on their HDD, then have the PDF filename used as the worksheet name.

The PDFs have the same naming convention: "MachineReport 1234ABC 31102011" where MachineReport is constant, and 1234ABC and 31102011 will vary - they are the machine serial number and date of report creation respectively.

Ideally I'd like the worksheet tab to be named with just 'MachineReport 1234ABC'.

And I'd like this to loop and allow the user to add multiple worksheets, one for each MachineReport PDF file selected by the user, named appropriately.

And for extra ease of use... the macro should, at the start, check for any worksheets already called 'MachineReport xxxxxxx' and delete them.

Sounds simple in theory but can I work it out? No. Hence why I'm asking the collective wisdom on here!!!

Thanks in advance!

 

[vaskov17]

try this, run "Control" macro to start the process:

Sub Control()
Dim strFile As String

Call DeleteSheets

Do
'get file name
strFile = Application.GetOpenFilename("PDF Files (*.pdf),*.pdf")

'if user cancels file selection then exit loop
If strFile = "False" Then
Exit Do
Else
Call AddSheet(strFile)
End If
Loop
End Sub

Sub AddSheet(strFile As String)
Dim ws As Worksheet
Dim part1 As String
Dim part2 As String

strFile = Left(strFile, Len(strFile) - 4) 'get rid of PDF extension

'get only the file name
Do
If InStr(1, strFile, "\", vbTextCompare) Then
strFile = Right(strFile, Len(strFile) - InStr(1, strFile, "\", vbTextCompare))
Else
Exit Do
End If
Loop

part1 = Left(strFile, InStr(1, strFile, " ", vbTextCompare))
strFile = Right(strFile, Len(strFile) - Len(part1))
part2 = Left(strFile, Len(strFile) - InStr(1, strFile, " ", vbTextCompare))

'add and rename worksheet
Set ws = Worksheets.Add
On Error Resume Next
ws.Name = part1 & " " & part2
If Err.Number <> 0 Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
MsgBox "Worksheet already exists", vbCritical
End If

Set ws = Nothing
End Sub

Sub DeleteSheets()
Dim ws As Worksheet

'delete worksheets with "MachineReport" in the name
Application.DisplayAlerts = False
For Each ws In Worksheets
If InStr(1, ws.Name, "MachineReport", vbTextCompare) Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub