excel cell =另一个工作簿的文件名
我有一个macros从另一个工作簿更新工作表，我怎样才能使用相同的文件来更新其文件名没有.xlsx单元格。
我可以使用vFile或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
谢谢
你可以得到没有path和没有扩展名的文件名如下：
Dim s As String s = Mid(vFile, InStrRev(vFile, "\") + 1) s = Left$(s, InStrRev(s, ".") - 1)
或者如果你想保持完整的path，但只删除扩展名：
Dim s As String s = Left(vFile, InStrRev(vFile, ".") - 1)
然后将其分配给任何单元格： myCell.Value = s
试试这个代码。
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
在你的项目中使用它，
With ActiveSheet .Range("A3").Value = NettFileName(.Parent.Name) End With