Ir para conteúdo
Fórum Script Brasil

eliasbrito.wong@gmail.com

Membros
  • Total de itens

    2
  • Registro em

  • Última visita

Sobre eliasbrito.wong@gmail.com

eliasbrito.wong@gmail.com's Achievements

0

Reputação

  1. Olá!Estou precisando de uma ajuda na programação VBA no OUTLOOK. Através da macro abaixo no Outlook, transfere as informações para um arquivo em EXCEL: Option ExplicitSub Outlook2Excel()Dim xlApp As ObjectDim xlWB As ObjectDim xlSheet As ObjectDim rCount As LongDim bXStarted As BooleanDim enviro As StringDim strPath As StringDim currentExplorer As ExplorerDim Selection As SelectionDim olItem As Outlook.MailItemDim obj As Object'Configurar novas strings (Celulas)Dim strColE As String'Configurações do Excelenviro = CStr(Environ("USERPROFILE"))'A parte da planilhastrPath = enviro & "\Documents\outlook2excel.xlsm" 'Nome do arquivo e local. *O arquivo tem que estar criado.On Error Resume NextSet xlApp = GetObject(, "Excel.Application")If Err <> 0 ThenApplication.StatusBar = "Aguarde por favor enquanto o Excel é executado..."Set xlApp = CreateObject("Excel.Application")bXStarted = TrueEnd IfOn Error GoTo 0'Abre a planilha para colocar as informaçõesSet xlWB = xlApp.Workbooks.Open(strPath)Set xlSheet = xlWB.Sheets("Plan1") 'nome da guia (o padrão das macros vem como Sheet1 e da erro)' Processo de gravação da mensagemOn Error Resume Next'Procura a proxima linha vazia da planilharCount = xlSheet.Range("E" & xlSheet.Rows.count).End(-4162).Row 'Informar qual coluna esta a macro da mensagem'Pega os valores do Outlook.*As informações tem que estar selecionadas!!!!!Set currentExplorer = Application.ActiveExplorerSet Selection = currentExplorer.Selection 'Pega os selecionadosFor Each obj In SelectionSet olItem = obj'Coleta dos camposstrColF = olItem.Subject 'Assunto da mensagemstrColB = olItem.SenderEmailAddress 'Igual ao senderemailaddressstrColE = olItem.Body 'corpo do emailstrColC = olItem.To 'Nome de quem envioustrColG = olItem.ReceivedTime 'Tempo da ultima respostastrColD = olItem.CC 'Emails copiados'Escreva na colunas da guia definidaxlSheet.Range("E" & rCount) = strColE 'MENSAGEM'Proxima linha!rCount = rCount + 1NextxlWB.Close 1If bXStarted ThenxlApp.Quit 'Fecha a planilhaEnd IfSet olItem = NothingSet obj = NothingSet currentExplorer = NothingSet xlApp = NothingSet xlWB = NothingSet xlSheet = NothingEnd Sub---------------Porem durante o processo, a coluna "E" aumenta o tamanho da linha devido o corpo do email que tem a quebra de pagina.Queria tirar a quebra de pagina em TEMPO REAL, ou seja, assim que transfere a informação.Como que faço isso no Outlook?
×
×
  • Criar Novo...