Я хочу, чтобы этот макрос работал во всех книгах, но он работает только в книге, которую я создал "book1.xlsm", и когда я переношу макрос в Personel.xlsb, он не работает. Может ли кто-нибудь помочь мне с этим?
Sub SendSelectedCells_inOutlookEmail()
Dim objSelection As Excel.Range
Dim objTempWorkbook As Excel.Workbook
Dim objTempWorksheet As Excel.Worksheet
Dim strTempHTMLFile As String
Dim objTempHTMLFile As Object
Dim objFileSystem As Object
Dim objTextStream As Object
Dim objOutlookApp As Outlook.Application
Dim objNewEmail As Outlook.MailItem
Dim strSig As String
'Copy the selection
Set objSelection = Selection
Selection.Copy
'Paste the copied selected ranges into a temp worksheet
Set objTempWorkbook = Excel.Application.Workbooks.Add(1)
Set objTempWorksheet = objTempWorkbook.Sheets(1)
'Keep the values, column widths and formats in pasting
With objTempWorksheet.Cells(1)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteFormats
End With
'Save the temp worksheet as a HTML file
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
strTempHTMLFile = objFileSystem.GetSpecialFolder(2).Path & "\Temp for Excel" & Format(Now, "YYYY-MM-DD hh-mm-ss") & ".htm"
Set objTempHTMLFile = objTempWorkbook.PublishObjects.Add(xlSourceRange, strTempHTMLFile, objTempWorksheet.Name, objTempWorksheet.UsedRange.Address)
objTempHTMLFile.Publish (True)
'Create a new email
Set objOutlookApp = CreateObject("Outlook.Application")
Set objNewEmail = objOutlookApp.CreateItem(olMailItem)
'Read the HTML file data and insert into the email body
Set objTextStream = objFileSystem.OpenTextFile(strTempHTMLFile)
objNewEmail.Display
strSig = objNewEmail.HTMLBody
objNewEmail.HTMLBody = objTextStream.ReadAll & strSig
'You can specify the new email recipients, subjects here using the following lines:
'objNewEmail.To = "[email protected]"
'objNewEmail.Subject = "DataNumen Products"
'objNewEmail.Send --> directly send out this email
objTextStream.Close
objTempWorkbook.Close (False)
objFileSystem.DeleteFile (strTempHTMLFile)
Конец сабвуфера
В новом файле вам нужно установить ссылку на объект для библиотеки объектов Microsoft Outlook, иначе строка Dim objOutlookApp As Outlook.Application
вызовет ошибку компиляции. Руководство здесь
Спасибо, что исправили :).
Рад, что смог помочь! В следующий раз вы должны добавить сообщение об ошибке в вопрос, чтобы людям было легче его понять.
«это не работает» не очень описательно — что именно он делает вместо того, чтобы работать?