Zamboni_du

@Midori me perdoe funcionou sim.

@Midori, bom dia!!!! Eu preciso fazer um queno ajuste, enviar apenas um parte da planilha, da célula A4:H30 como eu faria? Eu tentei colocara direto na linha criar uma variável mas não funcionou .

@Midori , eu fiz a alteração e como mencionei logo abaixo do que você escreveu o mesmo erro aconteceu. porém pode ser que eu não tenha entendio o que você descreveu, segue abaixo com a alteração que você mencionou: Sub enviar_corpo_email() Dim BR As Variant, dtToday As String, Anexo As Variant Dim xApp As Object Dim xFileDlg As FileDialog Dim xSelItem As Variant Dim xMail As MailItem 'Ordem numérica SQ01 Referência Planilha4.ListObjects("Tabela8").Sort.SortFields.Clear Planilha4.ListObjects("Tabela8").Sort.SortFields.Add2 _ Key:=Range("Tabela8[[#All],[Referência]]"), SortOn:=xlSortOnValues, Order _ :=xlAscending, DataOption:=xlSortTextAsNumbers With Planilha4.ListObjects("Tabela8").Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Seleciona o intervalo de células a serem enviadas por email. Planilha3.Select Planilha3.Range("A4:H28").Select ActiveWorkbook.EnvelopeVisible = True Set BR = Planilha12.Range("J3") dtToday = Date With ActiveSheet.MailEnvelope 'On Error Resume Next Set xApp = CreateObject("Excel.Application") xApp.Visible = False Set xFileDlg = xApp.Application.FileDialog(msoFileDialogFilePicker) xFileDlg.InitialFileName = "C:\Users\" & Environ("UserName") & "\Documents\SAP\SAP GUI" '"C:\Users\Win10x64Test\Desktop\save attachments\" 'Specify the path to the folder you want to open xFileDlg.AllowMultiSelect = True If xFileDlg.Show = 0 Then GoTo L1 Set xMail = Application.CreateItem(olMailItem) xMail.Display For Each xSelItem In xFileDlg.SelectedItems xMail.Attachments.Add xSelItem Next L1: xApp.Quit Set xFileDlg = Nothing Set xApp = Nothing .Item.To = Planilha11.Range("C21") .Item.Subject = "Rotas " & BR .Item.Display '.Item.Send End With 'Planilha10.Select End Sub

@Midori , bom dia!!!! Segue o código completo: Option Explicit Function Saudacao() As String Dim Hora As Date Hora = Format(Now, "HH:MM:SS") Select Case Hora Case "00:00:00" To "11:59:59" Saudacao = "Bom dia," Case "12:00:00" To "17:59:59" Saudacao = "Boa tarde," Case Else Saudacao = "Boa noite," End Select End Function Sub enviar_corpo_email() Dim BR As Variant, dtToday As String, Anexo As Variant Dim xApp As Object Dim xFileDlg As FileDialog Dim xSelItem As Variant Dim xMail As MailItem 'Ordem numérica SQ01 Referência Planilha4.ListObjects("Tabela8").Sort.SortFields.Clear Planilha4.ListObjects("Tabela8").Sort.SortFields.Add2 _ Key:=Range("Tabela8[[#All],[Referência]]"), SortOn:=xlSortOnValues, Order _ :=xlAscending, DataOption:=xlSortTextAsNumbers With Planilha4.ListObjects("Tabela8").Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Seleciona o intervalo de células a serem enviadas por email. Planilha3.Select Planilha3.Range("A4:H28").Select ActiveWorkbook.EnvelopeVisible = True Set BR = Planilha12.Range("J3") dtToday = Date With ActiveSheet.MailEnvelope 'On Error Resume Next Set xApp = CreateObject("Excel.Application") xApp.Visible = False Set xFileDlg = xApp.Application.FileDialog(msoFileDialogFilePicker) xFileDlg.InitialFileName = "C:\Users\Win10x64Test\Desktop\save attachments\" xFileDlg.AllowMultiSelect = True If xFileDlg.Show = 0 Then GoTo L1 Set xMail = Application.ActiveInspector.CurrentItem For Each xSelItem In xFileDlg.SelectedItems xMail.Attachments.Add xSelItem Next L1: xApp.Quit Set xFileDlg = Nothing Set xApp = Nothing .Item.To = Planilha11.Range("C21") .Item.Subject = "Rotas " & BR .Item.Display '.Item.Send End With End Sub

@Midori , Bom dia!!!!! Habilitei porém apareceu o mesmo erro.

@Midori @Midori , Enviar o email com as informações no corpo está funcionando corretamente, o que gostaria que aparecesse a opção de escolher um ou vários arquivo para anexar no email. O código abaixo deveria fazer isso porém não está fazendo . Set xApp = CreateObject("Excel.Application") xApp.Visible = False Set xFileDlg = xApp.Application.FileDialog(msoFileDialogFilePicker) xFileDlg.InitialFileName = "C:\Users\" & Environ("UserName") & "\"C:\Users\Win10x64Test\Desktop\save attachments\" 'Specify the path to the folder you want to open xFileDlg.AllowMultiSelect = True If xFileDlg.Show = 0 Then GoTo L1 Set xMail = Application.ActiveInspector.CurrentItem <- linha onde está apresentando o Erro em tempo de execução '438: Objeto não aceita esta propriedade ou método For Each xSelItem In xFileDlg.SelectedItems xMail.Attachments.Add xSelItem Next L1: xApp.Quit Set xFileDlg = Nothing Set xApp = Nothing

@Midori Bom dia!!!! Realizei a alteração e apresentou o mesmo erro. Esse código não abre uma nova janela do MS Outlook mas no próprio Excel.

@Midori @Midori Boa tarde!!!! Segue abaixo: Sub enviar_corpo_email() Dim BR As Variant, dtToday As String, Anexo As Variant Dim xApp As Object Dim xFileDlg As FileDialog Dim xSelItem As Variant Dim xMail As MailItem 'Organiza em Ordem numérica campo Referência Planilha4.ListObjects("Tabela8").Sort.SortFields.Clear Planilha4.ListObjects("Tabela8").Sort.SortFields.Add2 _ Key:=Range("Tabela8[[#All],[Referência]]"), SortOn:=xlSortOnValues, Order _ :=xlAscending, DataOption:=xlSortTextAsNumbers With Planilha4.ListObjects("Tabela8").Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Seleciona o intervalo de células a serem enviadas por email. Planilha3.Select Planilha3.Range("A4:H28").Select ActiveWorkbook.EnvelopeVisible = True Set BR = Planilha12.Range("J3") dtToday = Date With ActiveSheet.MailEnvelope 'On Error Resume Next Set xApp = CreateObject("Excel.Application") xApp.Visible = False Set xFileDlg = xApp.Application.FileDialog(msoFileDialogFilePicker) xFileDlg.InitialFileName = "C:\Users\" & Environ("UserName") & "\"C:\Users\Win10x64Test\Desktop\save attachments\" 'Specify the path to the folder you want to open xFileDlg.AllowMultiSelect = True If xFileDlg.Show = 0 Then GoTo L1 Set xMail = Application.ActiveInspector.CurrentItem <- linha onde está apresentando o Erro em tempo de execução '438: Objeto não aceita esta propriedade ou método For Each xSelItem In xFileDlg.SelectedItems xMail.Attachments.Add xSelItem Next L1: xApp.Quit Set xFileDlg = Nothing Set xApp = Nothing .Item.To = Planilha11.Range("C21") .Item.Subject = "Rotas " & BR .Item.Display '.Item.Send End With 'Planilha10.Select End Sub

@Midori Boa tarde, Deu erro nessa linha: Set xMail = Application.ActiveInspector.CurrentItem

O código abaixo a caixa de diálogo para escolher o arquivo porém não anexa. With ActiveSheet.MailEnvelope On Error Resume Next Set xApp = CreateObject("Excel.Application") xApp.Visible = False Set xFileDlg = xApp.Application.FileDialog(msoFileDialogFilePicker) xFileDlg.InitialFileName = "C:\Users\Win10x64Test\Desktop\save attachments\" 'Specify the path to the folder you want to open xFileDlg.AllowMultiSelect = True If xFileDlg.Show = 0 Then GoTo L1 Set xMail = Application.ActiveInspector.CurrentItem For Each xSelItem In xFileDlg.SelectedItems xMail.Attachments.Add xSelItem Next L1: xApp.Quit Set xFileDlg = Nothing Set xApp = Nothing

Bom dia!!!! Eu tenho uma aplicação para enviar e-mail direto do Excel, porém eu preciso em alguns casos escolher o anexo. Utilizando o método Attachments.Add eu consigo anexar um arquivo específico porém eu necessito que seja aberta a caixa de diálogo para que eu escolha o arquivo,

Boa noite, Gostaria de saber se existe a possibilidade de criar um forms de forma automática utilizando informações de uma planilha. Tenho uma planilha com algumas informações onde crio um forms para ser respondido, porém essas informações mudam diariamente e gostaria de automatizar esse processo.

Boa tarde pessoal tudo bem? Eu preciso encontrar o maior valor em uma coluna porém eu tentei a formula abaixo e me trouxe o valor "0" ao invés de 000062125-1 PriLin = Application.Max(Range("F10:F45")) Coluna F contem os valores: 000062111-1 000062112-1 000062125-1 000062113-1 000062115-1 000062116-1 000062114-1 000062117-1 000062118-1 000062119-1 000062120-1 000062121-1 000062122-1 000062123-1 000062124-1

@Wendell MenezesMenezes boa tarde!!!!! Entendi, minha dúvida é quanto ao tempo de excursão conforme as linhas forem aumentando. Minha ideia seria ao invés de testar linha por linha, encontrar as linha que correspondam com as variáveis Dada("J2") e "Cod2" e realizar a substituição.

@Wendell Menezes Boa tarde!!! Seria possível que a variável LR ao invés de contar quantas linhas tem contasse apenas quanta linhas com os critérios Data ("J2") e "Cod2"?