Question

我有一个用于从另一个工作簿更新工作表的宏，如何使用相同的文件更新一个没有.xlsx的文件名的单元格。

我可以使用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或wbCopyFrom Dim吗？

glPushMatrix()

由于

Answer 1

您可以在没有路径的情况下获取文件的名称，并且没有这样的扩展名：

hcidump -a l2cap | grep -v -e 'CAP' -e 'HCI' > onlystringsrecieved.txt

或者，如果您想保留完整路径，但只删除扩展程序：

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

然后将其分配给任何单元格：Dim s As String s = Left(vFile, InStrRev(vFile, ".") - 1)

Answer 2

试试这段代码。

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

excel cell =另一个工作簿的文件名

2 个答案: