如何解决已解决无法使用变量设置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
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。