Terça-feira, 20 2023 junho
  0 Respostas
  1.8 mil visitas
0
Votos
desfazer
Encontrei um código que me permite enviar datas de vencimento por e-mail. Estou tentando alterá-lo, para vincular o arquivo excel junto com isso. Fica azul; no entanto, não consigo clicar nele para abrir. Alguém sabe como posso corrigi-lo. Por favor ajude. Muito obrigado! Eu marquei a parte que eu mesmo adicionei em negrito.

Aqui está o código:

Sub CheckAndSendMail público()
'Atualizado por Extendoffice 2018/11/22
Dim xRgDate como intervalo
Dim xRgEnviar como intervalo
Dim xRgText como intervalo
Dim xRgDone como intervalo
Dim xOutApp como objeto
Dim xMailItem como objeto
Dim xLastRow Tão Longo
Dim vbCrLf como string
Dim xMailBody como string
Dim xRgDateVal como string
Dim xRgSendVal como string
Dim xMailSubject como string
Dim i tanto tempo
On Error Resume Next
Set xRgDate = Application.InputBox("Selecione a coluna da data de vencimento:", "KuTools For Excel", , , , , , 8)
Se xRgDate não for nada, saia do sub
Definir xRgSend = Application.InputBox ("Selecione os destinatários? Coluna de e-mail:", "KuTools For Excel", , , , , , 8)
Se xRgSend não for nada, saia do sub
Defina xRgText = Application.InputBox("Selecione a coluna com conteúdo lembrado em seu e-mail:", "KuTools For Excel", , , , , , 8)
Se xRgText não for nada, saia do sub
xÚltimaRow = xRgDate.Rows.Count
Definir xRgDate = xRgDate(1)
Definir xRgSend = xRgSend(1)
Definir xRgText = xRgText(1)
Set xOutApp = CreateObject("Outlook.Application")
Para i = 1 Para xLastRow
xRgDateVal = ""
xRgDateVal = xRgDate.Offset(i - 1).Valor
Se xRgDateVal <> "" Então
If CDate(xRgDateVal) - Data <= 7 E CDate(xRgDateVal) - Data > 0 Then
xRgSendVal = xRgSend.Offset(i - 1).Valor
xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
vbCrLf = " "
xMailBody = " "
xMailBody = xMailBody & " Olá, você adicionou novos itens" & vbCrLf
xMailBody = xMailBody & "Texto: " & xRgText.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & " L:\Público\23-Plant PDCA\2023\KACI Master 5S PDCA trail2.xlsm" & fpath & " "
xMailBody = xMailBody & " "
Definir xMailItem = xOutApp.CreateItem(0)
Com xMailItem
.Assunto = xMailAssunto
.Para = xRgSendVal
.HTMLBody = xMailBody
.Exibição
'.Mandar
Terminar com
Definir xMailItem = Nada
Se acabar
Se acabar
Próximo
Definir xOutApp = Nada
End Sub
Ainda não há respostas para esta postagem.