Attribute VB_Name = "Module1"
Option Explicit
Dim strFirstNames(5)
Dim strLastNames(5)

Dim strWorkCity(5)
Dim strWorkState(5)
Dim strWorkCountry(5)
Dim strWorkPhone(5)
Dim strWorkStreet(5)
Dim strWorkPostalCode(5)

Public Sub InitNameArrays()

    strFirstNames(0) = "Mindy"
    strFirstNames(1) = "Milissa"
    strFirstNames(2) = "Amy"
    strFirstNames(3) = "Stephanie"
    strFirstNames(4) = "Lyle"
    
    strLastNames(0) = "Martin"
    strLastNames(1) = "Jones"
    strLastNames(2) = "Smith"
    strLastNames(3) = "Curry"
    strLastNames(4) = "Tall"
    
    strWorkCity(0) = "Bellevue"
    strWorkState(0) = "WA"
    strWorkCountry(0) = "USA"
    strWorkPhone(0) = "(425) 705-1900"
    strWorkStreet(0) = "10500 NE 8th Street, Suite 1300"
    strWorkPostalCode(0) = "98004"

    strWorkCity(1) = "Phoenix"
    strWorkState(1) = "AZ"
    strWorkCountry(1) = "USA"
    strWorkPhone(1) = "(602) 266-0302"
    strWorkStreet(1) = "2929 Central Avenue, Suite 1200"
    strWorkPostalCode(1) = "85012"

    strWorkCity(2) = "Bloomington"
    strWorkState(2) = "MN"
    strWorkCountry(2) = "USA"
    strWorkPhone(2) = "(612) 896-1001"
    strWorkStreet(2) = "8300 Norman Center Drive, Suite 950"
    strWorkPostalCode(2) = "55437"

    strWorkCity(3) = "Atlanta"
    strWorkState(3) = "GA"
    strWorkCountry(3) = "USA"
    strWorkPhone(3) = "(770) 392-7400"
    strWorkStreet(3) = "Two Concourse Parkway, Suite 400"
    strWorkPostalCode(3) = "30328"

    strWorkCity(4) = "Waltham"
    strWorkState(4) = "MA"
    strWorkCountry(4) = "USA"
    strWorkPhone(4) = "(781) 487-6400"
    strWorkStreet(4) = "Prospect Hill, 230 Third Avenue"
    strWorkPostalCode(4) = "02451"

End Sub
Sub main()
Dim oPerson As New CDO.Person
Dim strFolderUrl
Dim strItemUrl
Dim strCRLF
Dim strItemName
Dim n, m, x

strFolderUrl = "file://./backofficestorage/ywd.extest.microsoft.com/mbx/user1/Contacts"
strCRLF = Chr(13) & Chr(10)

InitNameArrays

For n = 0 To 4
  For m = 0 To 4

    strItemName = strFirstNames(m) & " " & strLastNames(n)

    x = Int(5 * Rnd)

    With oPerson
      .FirstName = strFirstNames(m)
      .LastName = strLastNames(n)

      .HomeCity = "Chicago"
      .HomeState = "IL"
      .HomeCountry = "USA"
      .HomePhone = "555-1212"
      .HomeStreet = "100 Main Street"
      .HomePostalCode = "60657"

      .WorkCity = strWorkCity(x)
      .WorkState = strWorkState(x)
      .WorkCountry = strWorkCountry(x)
      .WorkPhone = strWorkPhone(x)
      .WorkStreet = strWorkStreet(x)
      .WorkPostalCode = strWorkPostalCode(x)

      .Email = strFirstNames(m) & "." & strLastNames(n) & "@microsoft.com"
    End With

    strItemUrl = strFolderUrl & "/" & strItemName & ".eml"
    Debug.Print strItemUrl
    
    oPerson.DataSource.SaveTo strItemUrl, , , adCreateOverwrite

    Set oPerson = Nothing
  Next
Next

End Sub
