excel cell = filename of another workbook

2
votes

I have a macro for updating a sheet from another workbook, how can I use that same file to update a cell with its filename without the .xlsx.

Can I use the vFile or wbCopyFrom Dim?

Sub UpdateTSOM()
Application.ScreenUpdating = False
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet

Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = ActiveSheet

If MsgBox("Update Transmission Stock Status data?", vbYesNo) = vbYes Then
Worksheets("TSOM").Range("B2:N3000").ClearContents
Else: Exit Sub
End If
 On Error GoTo whoa
'Open file with data to be copied
 vFile = "C:\Users\taylorm1\Desktop\OUC\_Materials\Stock Status\Transmission Stock Status*.xlsx"
'vFile = "P:\ESO\1790-ORL\OUC\_Materials\Stock Status\Transmission Stock Status **-**-**.xlsx"

Set wbCopyFrom = Workbooks.Open(vFile)
Set wsCopyFrom = wbCopyFrom.Worksheets(1)

'Copy Range
wsCopyFrom.Range("A1:N3000").Copy
'wsCopyFrom.Range("A1:A" & LastRow).Copy
wsCopyTo.Range("B2").PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False

SendKeys "Y"
SendKeys ("{ESC}")

'Close file that was opened
    wbCopyFrom.Close SaveChanges:=False
    Application.Wait (Now + 0.000005)
    Call NoSelect
    Exit Sub
    Application.ScreenUpdating = True
whoa:
    vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
    "*.xl*", 1, "Select Excel File", "Open", False)

Set wbCopyFrom = Workbooks.Open(vFile)
Set wsCopyFrom = wbCopyFrom.Worksheets(1)

'Copy Range
wsCopyFrom.Range("A1:N3000").Copy
'wsCopyFrom.Range("A1:A" & LastRow).Copy
wsCopyTo.Range("B2").PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False

SendKeys "Y"
SendKeys ("{ESC}")

'Close file that was opened
    wbCopyFrom.Close SaveChanges:=False
    Application.Wait (Now + 0.000005)
    Call NoSelect
    Exit Sub

'whoa: 'If filename changes then open folder
'Call Shell("explorer.exe" & " " & "P:\ESO\1790-ORL\OUC\_Materials\Stock Status", vbNormalFocus)

End Sub

Thanks

2
vbaexcel

2 Answers

1
votes

You can get the file's name without path and without extension like this:

Dim s As String
s = Mid(vFile, InStrRev(vFile, "\") + 1)
s = Left$(s, InStrRev(s, ".") - 1)

Or if you want to keep the full path but only remove the extension:

Dim s As String
s = Left(vFile, InStrRev(vFile, ".") - 1)

Then assign it to any cell: myCell.Value = s

1
votes

Try this code.

Private Sub TestNettFileName()
    Debug.Print NettFileName(ThisWorkbook.Name)
End Sub

Private Function NettFileName(Fn As String) As String

    Dim Sp() As String

    Sp = Split(ActiveWorkbook.Name, ".")
    ReDim Preserve Sp(UBound(Sp) - 1)
    NettFileName = Join(Sp, ".")
End Function

Use it in your project like,

With ActiveSheet
    .Range("A3").Value = NettFileName(.Parent.Name)
End With