Note: The other languages of the website are Google-translated. Back to English

¿Cómo enviar varios borradores a la vez en Outlook?

Si hay varios borradores de mensajes en su carpeta Borradores y ahora, desea enviarlos a la vez sin enviar uno por uno. ¿Cómo podría hacer frente a este trabajo de forma rápida y sencilla en Outlook?

Envíe todos los borradores de mensajes a la vez en Outlook con código VBA


Envíe todos los borradores de mensajes a la vez en Outlook con código VBA

Los siguientes códigos VBA pueden ayudarlo a enviar todos los correos electrónicos en borrador o seleccionados de la carpeta Borradores a la vez, haga lo siguiente:

1. Mantenga pulsado el ALT + F11 teclas para abrir el Microsoft Visual Basic para aplicaciones ventana.

2. Luego haga clic recuadro > Módulo, copie y pegue el código siguiente en el módulo en blanco abierto, vea la captura de pantalla:

Código de VBA: envíe todos los borradores de correos electrónicos a la vez en Outlook:

Sub SendAllDraftEmails()
Dim xAccount As Account
Dim xDraftFld As Folder
Dim xItemCount As Integer
Dim xCount As Integer
Dim xDraftsItems As Outlook.Items
Dim xPromptStr As String
Dim xYesOrNo As Integer
Dim i As Long
Dim xCurFld As Folder
Dim xTmpFld As Folder
On Error Resume Next
xItemCount = 0
xCount = 0
Set xTmpFld = Nothing
Set xCurFld = Application.ActiveExplorer.CurrentFolder
For Each xAccount In Outlook.Application.Session.Accounts
    Set xDraftFld = xAccount.DeliveryStore.GetDefaultFolder(olFolderDrafts)
    xItemCount = xItemCount + xDraftFld.Items.Count
    If xDraftFld.EntryID = xCurFld.EntryID Then
        Set xTmpFld = xCurFld.Parent
    End If
Next xAccount
Set xDraftFld = Nothing
If xItemCount > 0 Then
   xPromptStr = "Are you sure to send out all the drafts?"
    xYesOrNo = MsgBox(xPromptStr, vbQuestion + vbYesNo, "Kutools for Outlook")
    If xYesOrNo = vbYes Then
        If Not xTmpFld Is Nothing Then
            Set Application.ActiveExplorer.CurrentFolder = xTmpFld
        End If
        VBA.DoEvents
        For Each xAccount In Outlook.Application.Session.Accounts
            Set xDraftFld = xAccount.DeliveryStore.GetDefaultFolder(olFolderDrafts)
            Set xDraftsItems = xDraftFld.Items
            For i = xDraftsItems.Count To 1 Step -1
                If xDraftsItems.Item(i).Recipients.Count <> 0 Then
                    xDraftsItems.Item(i).sEnd
                    xCount = xCount + 1
                End If
            Next
        Next xAccount
        VBA.DoEvents
        Set Application.ActiveExplorer.CurrentFolder = xCurFld
        MsgBox "Successfully sent " & xCount & " messages", vbInformation, "Kutools for Outlook"
    End If
Else
    MsgBox "No Drafts!", vbInformation + vbOKOnly, "Kutools for Outlook"
End If
End Sub

3. Luego guarde el código y presione F5 para ejecutar este código, aparecerá un cuadro emergente para recordarle si envía todos los borradores, haga clic en, ver captura de pantalla:

4. Y aparecerá un cuadro de diálogo para recordarle cuántos borradores de correos electrónicos se han enviado, vea la captura de pantalla:

5. Y luego haz clic OK botón, todos los correos electrónicos en el Borradores La carpeta se enviará de inmediato, vea la captura de pantalla:

Notas

1. El código anterior enviará todos los borradores de correos electrónicos de todas las cuentas de Outlook.

2. Si solo desea enviar algunos correos electrónicos específicos desde la carpeta Borradores, aplique el siguiente código VBA:

Código de VBA: envíe correos electrónicos seleccionados desde la carpeta Borradores:

Sub SendSelectedDraftEmails()
Dim xSelection As Selection
Dim xPromptStr As String
Dim xYesOrNo As Integer
Dim i As Long
Dim xAccount As Account
Dim xCurFld As Folder
Dim xDraftsFld As Folder
Dim xTmpFld As Folder
Dim xArr() As String
Dim xCount As Integer
Dim xMail As MailItem
On Error Resume Next
xCount = 0
Set xTmpFld = Nothing
Set xCurFld = Application.ActiveExplorer.CurrentFolder
For Each xAccount In Outlook.Application.Session.Accounts
    Set xDraftsFld = xAccount.DeliveryStore.GetDefaultFolder(olFolderDrafts)
    If xDraftsFld.EntryID = xCurFld.EntryID Then
        Set xTmpFld = xCurFld.Parent
    End If
Next xAccount
If xTmpFld Is Nothing Then
    MsgBox "The current folder is not a draft folder", vbInformation, "Kutools for Outlook"
    Exit Sub
End If
Set xSelection = Outlook.Application.ActiveExplorer.Selection
If xSelection.Count > 0 Then
    xPromptStr = "Are you sure to send out the selected " & xSelection.Count & " draft item(s)?"
    xYesOrNo = MsgBox(xPromptStr, vbQuestion + vbYesNo, "Kutools for Outlook")
    If xYesOrNo = vbYes Then
        ReDim xArr(xSelection.Count - 1)
        For i = 1 To xSelection.Count
            xArr(i - 1) = xSelection.Item(i).EntryID
        Next
        Set Application.ActiveExplorer.CurrentFolder = xTmpFld
        VBA.DoEvents
        For i = 0 To UBound(xArr)
            Set xMail = Application.Session.GetItemFromID(xArr(i))
            If xMail.Recipients.Count <> 0 Then
                xMail.sEnd
                xCount = xCount + 1
            End If
        Next
        VBA.DoEvents
        Set Application.ActiveExplorer.CurrentFolder = xCurFld
        MsgBox "Successfully sent " & xCount & " messages", vbInformation, "Kutools for Outlook"
    End If
Else
    MsgBox "No items selected!", vbInformation, "Kutools for Outlook"
End If
End Sub

Artículos relacionados:

¿Cómo enviar un correo electrónico a varios destinatarios individualmente en Outlook?

¿Cómo enviar correos electrónicos masivos personalizados a una lista desde Excel a través de Outlook?

¿Cómo enviar un calendario a varios destinatarios individualmente en Outlook?

¿Cómo enviar correos electrónicos a varios destinatarios sin que ellos lo sepan en Outlook?


Kutools para Outlook: trae 100 funciones avanzadas a Outlook y hace que el trabajo sea mucho más fácil.

  • Auto CC / BCC por reglas al enviar correo electrónico; Reenvío automático Varios correos electrónicos personalizados; Respuesta automática sin servidor de intercambio y más funciones automáticas ...
  • Advertencia de BCC - mostrar mensaje cuando intente responder a todos si su dirección de correo está en la lista CCO; Recordar si faltan archivos adjuntosy más funciones de recordatorio ...
  • Responder (todos) con todos los archivos adjuntos en la conversación de correo; Responder muchos correos electrónicos en segundos; Agregar saludo automáticamente cuando responda; Agregar fecha al asunto ...
  • Herramientas de archivos adjuntos: administre todos los archivos adjuntos en todos los correos, Desconexión automática, Comprimir todo, Renombrar todo, Guardar todo ... Informe rápido, Contar correos seleccionados...
  • Potentes correos electrónicos no deseados por costumbre; Eliminar correos y contactos duplicados... Le permite hacerlo de forma más inteligente, más rápida y mejor en Outlook.
tiro kutools outlook kutools pestaña 1180x121
tiro kutools outlook kutools plus pestaña 1180x121
 
Comentarios (15)
Aún no hay calificaciones. ¡Sé el primero en calificar!
Este comentario fue minimizado por el moderador en el sitio
Brillante, funcionó de maravilla, gracias :)
Este comentario fue minimizado por el moderador en el sitio
einfach nur perfekt. Herzlichen Húmedo
Este comentario fue minimizado por el moderador en el sitio
Copiado como se indica arriba, pero cuando presiono F5 no pasa nada
Este comentario fue minimizado por el moderador en el sitio
Hola Cathleen,
El código anterior funciona bien en mi Outlook, ¿qué versión de Outlook usas?
Este comentario fue minimizado por el moderador en el sitio
Tengo varias cuentas de cambio. Quiero tener una de las cuentas que no es mi predeterminada para ser el remitente. ¿Dónde insertaría esto en el código? ¡Gracias!
Este comentario fue minimizado por el moderador en el sitio
¿Alguien recibió algunos correos electrónicos enviados a la carpeta eliminada haciendo esto?
Este comentario fue minimizado por el moderador en el sitio
Hola Bill,
¿Desea enviar varios correos electrónicos seleccionados de foder eliminado?
Por favor, da tu problema más detallado, ¡gracias!
Este comentario fue minimizado por el moderador en el sitio
Hola skyyang, estoy enfrentando el mismo problema. Por lo general, redacto entre 15 y 20 correos electrónicos y luego uso este código para enviarlos todos a la vez, pero luego me doy cuenta de que uno de esos correos electrónicos no se envía, sino que se envía a mi carpeta 'Eliminado'. Incluso el aviso dice la cantidad correcta de correos electrónicos, por ejemplo: '20 correos electrónicos enviados', pero cuando reviso, solo se habrían enviado 19, uno lo encontraré en mi carpeta de elementos eliminados. Quiero que todos los correos electrónicos se envíen a sus destinatarios sin errores. ¿Puedes decirme por qué sucede esto? Por favor ayuda.
Este comentario fue minimizado por el moderador en el sitio
Hola, Darewin, hemos actualizado los códigos anteriores, inténtalo de nuevo, ¡gracias!
Este comentario fue minimizado por el moderador en el sitio
Mismo problema: si selecciona 4 mensajes, después de enviar tres de ellos a la papelera (debido a la declaración "xDraftsItems.Item(i).Delete")
Este comentario fue minimizado por el moderador en el sitio
Usamos el script para enviar todos los borradores de correo electrónico a la vez para un lote de correos electrónicos de estado de cuenta generados a partir de sage 200. Los correos electrónicos en los elementos enviados se ven bien, pero los clientes los reciben con el texto del cuerpo en chino. ¿Alguna idea de lo que podría estar pasando aquí?
Este comentario fue minimizado por el moderador en el sitio
¿Puede explicar por qué el último correo (i = 1) se recrea en un nuevo MailItem en lugar de solo .Send?

Gracias.
Este comentario fue minimizado por el moderador en el sitio
Hola, una pregunta rápida, tal vez tengas una idea. Tenemos una aplicación externa que guarda todos los correos en la carpeta de borradores. si ejecuto la macro, tenemos el problema de que solo el primer correo de la lista se envía correctamente, todos los demás correos se difieren porque agrega comillas ' ' a la dirección del correo. ¿Hay alguna manera de evitar esto?
Este comentario fue minimizado por el moderador en el sitio
Este código envía todos los borradores en una subcarpeta llamada Merge Tools (te pregunta antes de enviar). Sin embargo, estoy seguro de que ustedes pueden editarlo para satisfacer sus necesidades. Es mucho más simple. Disfrutar :)
Sub SendAllFusionarHerramientasBorradores()

If MsgBox("¿Está seguro de que desea enviar TODOS los elementos en su carpeta de borradores de Merge Tools?", _
vbPregunta + vbSíNo) <> vbSí Luego Salir de Sub

Dim myNamespace As Outlook.NameSpace 'Cambiar vista a Bandeja de entrada para evitar errores en línea
Establezca myNamespace = Application.GetNamespace("MAPI") 'Cambiar vista a Bandeja de entrada para evitar errores en línea
Establecer aplicación.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) 'Cambiar vista a Bandeja de entrada para evitar errores en línea

Dim fldDraft como MAPIFolder, msg como Outlook.MailItem, intCount como entero
Establecer fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).Folders("Folder Tools") 'Envía todos los borradores en la carpeta Merge Tools solamente
cuentaint = 0
Hacer mientras fldDraft.Items.count > 0
Establecer mensaje = fldDraft.Items(1)
mensaje.Enviar
intCuenta = intCuenta + 1
Red ISTE Loop
Si no (el mensaje no es nada), entonces establezca el mensaje = Nada
Establecer fldDraft = Nada
MsgBox intCount & "mensajes enviados", vbInformation + vbOKOnly

End Sub
Este comentario fue minimizado por el moderador en el sitio
Hola chicos. Pensé en compartir. Aquí está mi código para enviar todos los borradores:
Sub SendAllDrafts() 'Por jamesmalcolmwood@gmail.com

If MsgBox("¿Está seguro de que desea enviar TODOS los elementos de su carpeta de borradores?", _
vbPregunta + vbSíNo) <> vbSí Luego Salir de Sub

Dim myNamespace As Outlook.NameSpace 'Cambiar vista a Bandeja de entrada para evitar errores en línea
Establezca myNamespace = Application.GetNamespace("MAPI") 'Cambiar vista a Bandeja de entrada para evitar errores en línea
Establecer aplicación.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) 'Cambiar vista a Bandeja de entrada para evitar errores en línea

Dim fldDraft como MAPIFolder, msg como Outlook.MailItem, intCount como entero
Establecer fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts) 'Envía todos los borradores en su carpeta principal de borradores. Para una subcarpeta, agregue .Folders("nombre de la carpeta")
cuentaint = 0
Hacer mientras fldDraft.Items.count > 0
Establecer mensaje = fldDraft.Items(1)
mensaje.Enviar
intCuenta = intCuenta + 1
Red ISTE Loop
Si no (el mensaje no es nada), entonces establezca el mensaje = Nada
Establecer fldDraft = Nada
MsgBox intCount & "mensajes enviados", vbInformation + vbOKOnly

End Sub
No hay comentarios publicados aquí todavía
Deje sus comentarios
Publicar como invitado
×
Califica esta publicación:
0   Personajes
Ubicaciones sugeridas

Seguinos

Copyright © 2009 - www.extendoffice.com. | Reservados todos los derechos. Energizado por ExtendOffice, | Mapa del Sitio
Microsoft y el logotipo de Office son marcas comerciales o marcas comerciales registradas de Microsoft Corporation en los Estados Unidos y / o en otros países.
Protegido por Sectigo SSL