Sunday, 13 November 2016

Sunday, 6 November 2016

Excel macro to send e-mail with attachments using outlook

  Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
lr = Range("A65536").End(xlUp).Row 'Detects the last row with data
If lr > 1 Then
    Set OutApp = CreateObject("Outlook.Application")
    For i = 2 To lr
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Enter your mail content here"

    With OutMail
        .To = "Enter email address of the receiver"
        .CC = ""
        .BCC = ""
        .Subject = "Enter subject line here"
        .Body = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Send
    End With


    Set OutMail = Nothing
    Next
    Set OutApp = Nothing
End If

VBA code to print all Excel files in a selected folder

Sub PrintSpecificWorkbooks()
On Error Resume Next
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim strPath As String
Dim strName As String
Dim blnTask As Boolean

strPath = C:/Excel Files 'Select your folder path here
If strPath = "" Then
MsgBox "Please select the folder to print"
Exit Sub
End If

If Val(Application.Version) >= 10 Then
blnTask = Application.ShowWindowsInTaskbar
Application.ShowWindowsInTaskbar = False
End If
Application.ScreenUpdating = False
' Specify the folder...

' Use Microsoft Scripting runtime.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPath)

' Check type of file in the folder and open file.
For Each objFile In objFolder.Files
If objFile.Name Like "*.xlsx" Then 'Select all the xlsx files in the folder
strName = objFile.Name
Application.StatusBar = strName
Workbooks.Open objFile
lr = ActiveSheet.Range("C65536").End(xlUp).Row 'Detects the last row in excel file
ActiveSheet.PageSetup.PrintArea = Range("A1:D" & lr) 'Prints area from A to D
Workbooks(strName).PrintOut
Workbooks(strName).Close savechanges:=False
End If
Next
End Sub