html链接无法使用,超链接无法使用范围HTML功能

使用一些VBA抓取信息表并粘贴到使用范围到HTML的电子邮件的正文。问题似乎与超链接有关，因为该功能只是将其作为文本抓取并相应地进行格式化。我使用的VBA是：超链接无法使用范围HTML功能

使用.Cells(1).PasteSpecial xlPasteAll, , False, False

，而不是线.Cells(1).PasteSpecial xlPastevalues, , False, False

功能：

Sub Archive_Send()

Dim rng As Range

Dim OutApp As Object

Dim OutMail As Object

Dim rngTo As Range

Dim rngSubject As Range

Dim rngBody1 As Range

Dim StrBody As String

Dim StrBody1 As String

Set rng = Nothing

On Error Resume Next

Set rng = Sheets("Posting").Range("B5:C55").SpecialCells(xlCellTypeVisible)

On Error GoTo 0

If rng Is Nothing Then

MsgBox "The selection is not a range or the sheet is protected" & _

vbNewLine & "please correct and try again.", vbOKOnly

Exit Sub

End If

With Application

.EnableEvents = False

.ScreenUpdating = False

End With

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

Set rngTo = Sheets("Email").Range("C5")

Set rngSubject = Sheets("Email").Range("C3")

Set rngBody1 = Sheets("Email").Range("C13")

On Error Resume Next

With OutMail

.To = rngTo.Value

.Subject = rngSubject.Value

.HTMLBody = .HTMLBody & rngBody1.Value & "" _

& RangetoHTML(rng) _

& "
Best Regards,
"

.Display

End With

On Error GoTo 0

With Application

.EnableEvents = True

.ScreenUpdating = True

End With

Set OutMail = Nothing

Set OutApp = Nothing

Application.ReferenceStyle = xlA1

End Sub

Function RangetoHTML(rng As Range)

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Dim fso As Object

Dim ts As Object

Dim TempFile As String

Dim TempWB As Workbook

TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy") & ".htm"

rng.Copy

Set TempWB = Workbooks.Add(1)

With TempWB.Sheets(1)

.Cells(1).PasteSpecial Paste:=8

.Cells(1).PasteSpecial xlPasteValues, , False, False

.Cells(1).PasteSpecial xlPasteFormats, , False, False

.Cells(1).Select

Application.CutCopyMode = False

On Error Resume Next

.DrawingObjects.Visible = True

On Error GoTo 0

End With

With TempWB.PublishObjects.Add(_

SourceType:=xlSourceRange, _

Filename:=TempFile, _

Sheet:=TempWB.Sheets(1).Name, _

Source:=TempWB.Sheets(1).UsedRange.Address, _

HtmlType:=xlHtmlStatic)

.Publish (True)

End With

Set fso = CreateObject("Scripting.FileSystemObject")

Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

RangetoHTML = ts.ReadAll

ts.Close

RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _

"align=left x:publishsource=")

TempWB.Close SaveChanges:=False

Kill TempFile

Set ts = Nothing

Set fso = Nothing

Set TempWB = Nothing

End Function

+0

如果您注释掉执行PasteSpecial的部分会发生什么？ –

+0

嗨 - 其实我只是通过添加一些线来获取单元格中的超链接，并将其显示在HTML到范围函数的表格上方来解决此问题： .HTMLBody = .HTMLBody＆rngBody1.Value＆“

“_ ＆” Click here to view posting

“_ –