已解决无法使用变量设置OLEObject名称

问题描述

我终生无法获得下面的代码来重命名OLEObject。其他所有东西都可以正常工作，该对象已嵌入并且oname变量在其他行中使用时可以工作，但是由于某些原因，.name命令将不起作用。代码运行，没有错误，只是没有按照我的要求做。

有人对这可能是为什么有任何想法吗？

Public Sub insertFiles()
Dim newObject As Object
Dim oname As String
Dim CheckName As String
 
CheckName = UserForm1.MultiPage2.SelectedItem.Caption
oname = CheckName & "_" & "Evidence" & "_" & UserForm1.ProjectName.Value & "_" & Format(Date,"ddmmmyyyy")

Worksheets("Emails").Activate
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    Set Rng = ActiveCell
    Rng.RowHeight = 70
    
    On Error Resume Next
      fpath = Application.GetopenFilename("All Files,*.*",Title:="Select file")
    If LCase(fpath) = "false" Then Exit Sub
    
    If UserForm1.ProjectName.Value <> Empty Then
    
       
ActiveCell.Value = "."

ActiveSheet.OLEObjects.Add(Filename:=fpath,_
    Link:=False,_
    displayAsIcon:=True,_
    IconFileName:="Outlook.msg",_
    IconIndex:=1,_
   IconLabel:=extractFileName(fpath)).Name = oname
    
 

ActiveCell.Offset(0,1).Value = oname
UserForm1.Attached1.Value = oname
ThisWorkbook.Worksheets("Output").Range("B35").Value = oname

Call UserForm1.TickBox

UserForm1.LablePIA.Visible = True
UserForm1.Attached1.Visible = True
UserForm1.View.Visible = True
UserForm1.Deleteemail.Visible = True

MsgBox "Attachment uploaded"
  
Else
MsgBox "Project Name must be input before emails can be uploaded"
End If
End Sub

Public Function extractFileName(filePath)
    For i = Len(filePath) To 1 Step -1
        If Mid(filePath,i,1) = "\" Then
        extractFileName = Mid(filePath,i + 1,Len(filePath) - i + 1)
        Exit Function
        End If
    Next

End Function

解决方法

OLEObject名称不能超过35个字符（大概是除非使用类模块！）。

尝试这样

Dim Obj As OLEObject

set Obj = ActiveSheet.OLEObjects.Add(Filename:=fpath,_
    Link:=False,_
    DisplayAsIcon:=True,_
    IconFileName:="Outlook.msg",_
    IconIndex:=1,_
   IconLabel:=extractFileName(fpath))

Obj.name = oname

createoleobject excel excel vba