Sending Automated emails from Excel via YahooMail

Hello Everyone,

I have written other blogs on sending mail from Excel using VBA via Outlook and Gmail.

This blog contains the code for sending mails from Excel using VBA via YahooMail.
This is tested from a personal free yahoo account.
Here is the code for the same:


Sub automated_email_yahooMail()
    
    Dim mail As CDO.Message
    Set mail = New CDO.Message

    With mail.Configuration.Fields
   
       '1. Setting SSL Authentication
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
       '2. Setting SMTP Authentication
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
       '3. Setting SMTP Server and Port
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mail.yahoo.com"
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
       
       
       .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        
       'USERID AND PASSWORD
       .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "emailID@yahoo.com"
       .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
        
       'Don't forget to Update the configuration fields
       .Update
    End With
    
    With mail
       .To = "emailID1@domain.com"
       .From = "emailID@yahoo.com"
       .Sender = "Warlock Solutions"
       .CC = "emailID2@domain.com"
       .BCC = "emailID3@domain.com"
       .Subject = "Test mail from VBA via YahooMail"
       .textbody = "Please respond if you've received."
       .AddAttachment "Path\attachmentName.attachmentExtension"
       .Send
    End With
    
    Set mail = Nothing
End Sub

Please put your thoughts and comments below so that I can improve.

THANKS EVERYONE.

SUBHAJIT.

Sending Automated emails from Excel via GMAIL

Hello Everyone,

This blog contains details regarding sending automated emails from excel.

The other blog that I wrote on similar line is used to send mail via yahooMail.

This blog contains the code for sending MAILS VIA GMAIL.

This is tested from an corporate google account.

Here is the code for the same :

Sub automated_email_gmail()
   
    Dim mail As CDO.Message
    Set mail = New CDO.Message

    With mail.Configuration.Fields
  
       '1. Setting SSL Authentication
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
       '2. Setting SMTP Authentication
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
       '3. Setting SMTP Server and Port
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
      
      
       .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
       
       'Credentials of your Gmail Account
       'https://myaccount.google.com/
       'https://myaccount.google.com/security
       'Go to App Passwords
       'Select "Mail" in Select App
       'Select "Windows Computer" in Select device
       'Click Generate
       'Copy the password generated and paste it in the password field
      
       'USERID AND PASSWORD
       .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "emailID@domain.com"
       .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Case Sensitive Password"
       
       'Don't forget to Update the configuration fields
       .Update
    End With

    With mail
       .To = "emailID1@domain.com"
       .From = "emailID@domain.com"
       .Sender = "Warlock Solutions"
       .CC = "emailID2@domain.com"
       .BCC = "emailID3@domain.com"
       .Subject = "Test mail via gmail"
       .textbody = "Please respond if you've received."
       .AddAttachment "Path\attachmentName.attachmentExtension"
       .Send
    End With

    Set mail = Nothing

End Sub

Please put your thoughts and comments below so that I can improve.

THANKS EVERYONE.

SUBHAJIT.

Expressions for Excel VBA Environ

Here's a list of few expressions for the Environ in Excel VBA

Environ("os")

Environ("tmp")

Environ("path")

Environ("path")

Environ("windir")

Environ("appdata")

Environ("appdata")

Environ("homepath")

Environ("username")

Environ("homedrive")

Environ("userdomain")

Environ("logonserver")

Environ("sessionname")

Environ("systemdrive")

Environ("userprofile")

Environ("computername")

Environ("programfiles")

Environ("allusersprofile")

Environ("processor_level")

Environ("commonprogramfiles")

Environ("processor_revision")

Environ("number_of_processors")

Environ("processor_identifier")

Environ("processor_architecture")

Will keep updating the list as and when i come across new once.

Thanks

Subhajit

Exploring The File System Object_Part 2

In my previous post I explored the few  methods of the fileSystemObject to find all the Sub Folders in a parent folder. Count of all files in them, their size and filetypes.

In this post I have used few more methods to build a macro which will do the following:

1. Does whatever was possible in the last post ;) 
2. Make different folders for different file types
3. Copy all the files from the specified folder
4. Organize the similar file types into their respective folders

This is how the excel file looks,

This is the main() subroutine which calls the organize routine,

This is the routine that organizes different file types into different folders

This is the initial and final output folders:

Please put your thoughts and comments below so that I can improve.

THANKS EVERYONE.
SUBHAJIT.
.
To Download the example file:
Please click this Google Drive Link

Exploring The File System Object_Part 1

We can use the Microsoft scripting runtime object library for working easily with files and folders.
Start with opening the references and checking the Microsoft scripting runtime library.
This gives a lot of objects collections, methods and properties in the scripting library.
You can browse through them by opening the object library.

Given below is a sample code for exploring few possibilities of the file system object. 

Put any folder link in the range(A2) and see the following information about the folder.

Sub Directories, Total Count of Files, File Types, Count of File Types , Size of Folder

Please find the file link below to see and explore the file.

========================================================================

========================================================================

Will write another blog on exploring properties of file methods.

Please put your thoughts and comments below so that I can improve.

THANKS EVERYONE.
SUBHAJIT.
.
To Download the example file:
Please click this Google Drive Link

Sending Automated emails - WITH GENERIC AND CUSTOMIZED CONTENT Via Outlook

Hello Everyone,


Long time I have written a blog on Excel VBA.

This blog contains details regarding sending automated emails from an excel template, which is a common thing and you'll find many other blogs for the same.


But What's different in this is:

1. You can use customized names for few user and the generic name for the rest.
2. Send a copy of the mail to an individual person or just CC to the generic address.
3. You can use customized subject for few user and the generic subject for the rest.
4. You can have customized message body for few user and the generic content for the rest.
5. You can use customized signatures for few user and the generic signature for the rest.
6. You can also have attachments for few users.

Here is the code for the same :

Sub automated_email()
    
    Dim counter As Long
    
    Dim outlookApp As Outlook.Application
    Dim outlookMail As MailItem
    Set outlookApp = New Outlook.Application
    
    Dim bodyString As String
    
    For counter = 5 To formatEmail.Cells(formatEmail.Rows.Count, "A").End(xlUp).Row

        Set outlookMail = outlookApp.CreateItem(outlookMailItem)
        outlookMail.To = formatEmail.Range("B" & counter).Value
        
        If formatEmail.Range("C" & counter).Value <> "" Then
            outlookMail.CC = formatEmail.Range("C" & counter).Value
        Else
            outlookMail.CC = formatEmail.Range("C2").Value
        End If
        
        outlookMail.BCC = formatEmail.Range("D" & counter).Value
        
        If formatEmail.Range("E" & counter).Value <> "" Then
            outlookMail.Subject = formatEmail.Range("E" & counter).Value
        Else
            outlookMail.Subject = formatEmail.Range("E2").Value
        End If
        
        bodyString = "Hi "
        
        If formatEmail.Range("A" & counter).Value <> "" Then
            bodyString = bodyString & formatEmail.Range("A" & counter).Value & "," & vbNewLine & vbNewLine
        Else
            bodyString = bodyString & formatEmail.Range("A2").Value & "," & vbNewLine & vbNewLine
        End If
        If formatEmail.Range("G" & counter).Value <> "" Then
            bodyString = bodyString & formatEmail.Range("G" & counter).Value & vbNewLine & vbNewLine
        Else
            bodyString = bodyString & formatEmail.Range("G2").Value & vbNewLine & vbNewLine
        End If
        If formatEmail.Range("H" & counter).Value <> "" Then
            bodyString = bodyString & formatEmail.Range("H" & counter).Value & vbNewLine & vbNewLine
        Else
            bodyString = bodyString & formatEmail.Range("H2").Value & vbNewLine & vbNewLine
        End If
        
        outlookMail.Body = bodyString
        
        If formatEmail.Range("F" & counter).Value <> "" Then
            If Dir(formatEmail.Range("F" & counter).Value) <> "" Then
                outlookMail.Attachments.Add formatEmail.Range("F" & counter).Value
            End If
        End If
        
'        Use outlookMail.Display to review before sending
        outlookMail.Display
        
'        Use outlookMail.Send to directly send without reviewing
'        outlookMail.Send
        
    
        Set outlookMail = Nothing
    Next
       
    Set outlookApp = Nothing
    
End Sub

Please put your thoughts and comments below so that I can improve.

THANKS EVERYONE.
SUBHAJIT.
.
To Download the example file:
Please click this Google Drive Link

Search and Populate Matching Text

If you need to search your text and populate a list box based on the matching texts then here is a simple trick.

The list box will refresh after every new character typed in the text box and populate the list box with all matching characters.

The same can be used to populate a combo box or storing the matching texts in an array.

Data :

Fig: Data Structure

Search :

Fig: Search Sheet

Code :


Private Sub txt_item_Change()
    
    If txt_item.Text = "" Then
        lb_item.Clear
        search.Range("F2").Value = 0
        Exit Sub
    End If
    
    Dim rowCount, count, i As Long
    Dim colno As Integer
    
    search.lb_item.Clear
    
    colno = CInt(search.Range("E11").Value)
    rowCount = data.Range(search.Range("D11").Value & Rows.count).End(xlUp).Row
    count = 0
    
    For i = 2 To rowCount
        If InStr(1, Left(CStr(data.Cells(i, colno).Value), Len(txt_item.Text)), txt_item.Text, 1) Then
            search.lb_item.AddItem data.Cells(i, colno).Value
            count = count + 1
        End If
    Next i
    
    search.Range("F2").Value = count
    

End Sub

However to use this type of search for a data source exceeding 1 million records optimization is required. Indexing before search would be best in that case. Will update the same in the next blog.

Example File Link

Simple Login Screen using VBA

Here is a simple example to create a login screen to validate user credentials in excel

Step 1:

Create a simple user form with required text boxes and buttons

Step 2:
Write the following code for the respective buttons:

Private Sub cmd_login_Click()
    
    If txt_user.Text = "" Or txt_pass.Text = "" Then
        MsgBox "User ID or password field cannot be blank", vbCritical, "Invalid Login"
        Exit Sub
    End If
    '=========================
    '       USER ID's
    '=========================
    Dim userID(10) As String
    userID(0) = "sunny"
    userID(1) = "guest"
    
    '=========================
    '       PASSWORDs
    '=========================
    Dim passID(10) As String
    passID(0) = "admin"
    passID(1) = "guest"
    
    Application.DisplayAlerts = False
    Dim i As Integer
    Dim userName, passWord As String
    Dim userStatus, passStatus As String
    Dim loginStatus As String
    userStatus = passStatus = ""
    userName = txt_user.Text
    passWord = txt_pass.Text
    For i = 0 To UBound(userID)
        If userName = userID(i) Then
            userStatus = "Found"
            Exit For
        End If
    Next i
    If userStatus = "Found" Then
        If passWord = passID(i) Then
            passStatus = "Found"
            Call cmd_reset_Click
            frm_login.Hide
            welcomescreen.Visible = xlSheetVisible
            lockScreen.Visible = xlSheetVeryHidden
            Call updateUserDetails(userName)
            ActiveWorkbook.Save
            Application.DisplayAlerts = True
        Else
            MsgBox "Incorrect username or password.", vbCritical, "Login Failed"
            Call cmd_reset_Click
        End If
    Else
        MsgBox "Incorrect username or password.", vbCritical, "Login Failed"
        Call cmd_reset_Click
    End If
End Sub

Private Sub cmd_reset_Click()
    txt_user.Text = ""
    txt_pass.Text = ""
    txt_user.SetFocus
End Sub

Private Sub cmd_cancel_Click()
    Application.DisplayAlerts = False
    frm_login.Hide
    ActiveWorkbook.Close
End Sub

Step 3:
Add these lines of code for hiding whats there in your excel file. So that the user cannot see the stuff behind the login screen before logging into the file. lockScreen is the sheetname of the worksheet we'll use as a default screen.

Private Sub UserForm_Activate()
    lockScreen.Visible = xlSheetVisible
    lockScreen.Select
End Sub

Private Sub UserForm_Terminate()
    ActiveWorkbook.Close
    lockScreen.Visible = xlSheetVeryHidden
End Sub

The user id password for using the example file is:
user id: sunny
password: admin

 

It also keeps track of all the user login instances with time stamp. In a hidden log Sheet.

Link for the example file

Split String into Alphabets and Digits - Type 1

Description :

Here's an example of a User Defined Function for extracting Alphabets and Digits from any given string.

Code :

Option Explicit

Public Function splitString(ByVal inputStr As String, ByVal outputType As Integer)
    Dim i As Long
    Dim numPart As String
    Dim strPart As String
    
    ' if outputType = 0 then display digits
    ' if outputType = 1 then display Alphabets
    
    For i = 1 To Len(inputStr)
        If Asc(Mid(inputStr, i, 1)) > 47 And Asc(Mid(inputStr, i, 1)) < 58 Then
            numPart = numPart & Mid(inputStr, i, 1)
        ElseIf Asc(Mid(inputStr, i, 1)) > 64 And Asc(Mid(inputStr, i, 1)) < 91 Then
            strPart = strPart & Mid(inputStr, i, 1)
        ElseIf Asc(Mid(inputStr, i, 1)) > 96 And Asc(Mid(inputStr, i, 1)) < 123 Then
            strPart = strPart & Mid(inputStr, i, 1)
        End If
    Next i
    
    If outputType = 0 Then
        splitString = numPart
    ElseIf outputType = 1 Then
        splitString = strPart
    End If

End Function

Output :

input	digits	string
sdfds3243	3243	sdfds
sefd323	323	sefd
sfd 32423	32423	sfd
fds  4323	4323	fds
f g j  6 899  9	68999	fgj

input	digits	string
sdfds3243	=splitString(A2,0)	=splitString(A2,1)

Example File Link :

Example File

Extracting Output in Other Format Type 1

If your have data in the given structure and you want it to restructure your data into a given format then you can use this code to restructure and format your new data block.

Input data Structure:

Output Data Structure:

Code :

Option Explicit

Sub split()
    
    Dim i, j, k, splitRow, splitCol, blockCount, columnCount, segmentCol As Long
    Dim dataBlock(500) As String
    Dim dataBlockCol(500) As Integer
    
    Dim summaryRow, countGFS As Integer
    summaryRow = ((Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row - 2) * 2) + 1
    
    splitRow = 2
    splitCol = 1
    segmentCol = 1
    blockCount = 0
    Sheet2.Cells.Clear
    
    'finding data names and location of individual data blocks
    For i = 2 To Sheet1.UsedRange.Columns.Count
        If Sheet1.Cells(1, i).Value <> "" Then
            blockCount = blockCount + 1
            dataBlock(blockCount) = CStr(Sheet1.Cells(1, i).Value)
            dataBlockCol(blockCount) = i
        End If
    Next i
    
    countGFS = 2
    'spliting cell contents
    For j = 1 To blockCount
        Sheet2.Cells(1, splitCol).Value = dataBlock(j)
        
        Sheet2.Cells(summaryRow - 1, splitCol).Value = "-"
        Sheet2.Cells(summaryRow, splitCol).Value = dataBlock(j)
        Sheet2.Cells(summaryRow + 1, splitCol).Value = "ASDF"
        
        columnCount = 0
        For i = 3 To Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row - 1

            Sheet2.Cells(1, splitCol + 1).Value = "Col" & CStr(columnCount)

            Sheet2.Cells(splitRow, segmentCol).Value = Sheet1.Range("A" & CStr(i)).Value
            Sheet2.Cells(splitRow, splitCol + 1).Value = Sheet1.Cells(i, dataBlockCol(j) + 4).Value
            Sheet2.Cells(splitRow + 1, segmentCol).Value = Sheet1.Range("A" & CStr(i)).Value
            Sheet2.Cells(splitRow + 1, splitCol + 1).Value = Sheet1.Cells(i, dataBlockCol(j) + 5).Value
            
            Sheet2.Cells(summaryRow - 1, splitCol + 1).Value = "-"
            Sheet2.Cells(summaryRow, splitCol + 1).Value = Sheet1.Cells(2, countGFS).Value
            Sheet2.Cells(summaryRow + 1, splitCol + 1).Value = Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row, countGFS).Value
            
            splitRow = splitRow + 2
            splitCol = splitCol + 1
            columnCount = columnCount + 1
            countGFS = countGFS + 1
            
            If i = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row - 1 Then
                Sheet2.Cells(summaryRow, splitCol + 1).Value = Sheet1.Cells(2, countGFS).Value
                Sheet2.Cells(summaryRow + 1, splitCol + 1).Value = Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row, countGFS).Value
            End If
            
            
        Next i
        
        countGFS = countGFS + 1
        splitRow = 2
        splitCol = Sheet2.UsedRange.Columns.Count + 4
        segmentCol = splitCol

    Next j
    
    'copying formatting
    Sheet2.Select
    For j = 1 To blockCount
        If j = 1 Then
            Range("A1").Select
        Else
            Cells.Find(What:=dataBlock(j), After:=ActiveCell, LookIn:=xlValues, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True _
            , SearchFormat:=False).Activate
        End If
        
        
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Sheet1.Select
        Cells.Find(What:=dataBlock(j), After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False).Activate
        ActiveCell.Offset(1, 0).Select
        Selection.Copy
        Sheet2.Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        
        Selection.End(xlDown).Select
        Selection.Copy
        Selection.End(xlToRight).Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        ActiveCell.Offset(-1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Range("A1").Select
        Application.CutCopyMode = False
    Next j
    
    Rows(summaryRow - 1).Clear
    Cells.Select
    Selection.Columns.AutoFit
    Range("A1").Select
    
    Sheet1.Select
    Range("A1").Select
    
    Sheet2.Select
    MsgBox "Split complete"
    
End Sub

Explanation :

In the above mentioned code
Sheet1 is the Input Data Sheet
Sheet2 is the Output Data Sheet

Example File link :

Example File

Update Pivot Table using VBA (Change Data Source and Add New Data into Pivot)

If you have a data set in which a new column is added at a specified time interval then refreshing the pivot every time becomes monotonous.

Excel macro can be used to automate this process.

1. Changing the old data source and adding the new column into the data set.

2. Manipulating the table structure and and adding the new columns into 

the rows or columns or filters or values.

3. Refreshing the table structure with the new data.

Given below is the code to do the same.

1. Adding the new column in values section

Sub()


Sheet1.PivotTables("PivotTable1").ChangePivotCache ActiveWorkbook. _
        PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Raw data!R3C1:R21C" & CStr(Sheet2.UsedRange.Columns.Count) _
        , Version:=xlPivotTableVersion14)
    
    Sheet1.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields(fieldName), "Sum of " & fieldName, xlSum

    ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh

    ActiveWorkbook.RefreshAll


The new field can also be added to the xlRowField, xlColumnField and xlPageField

Please find example file here.
https://drive.google.com/file/d/0B20WcznMWRTfMzBnd29JeG9LalE/view?usp=sharing