How do I format a cell with a time in so that VBA mail merge displays it as time not a decimal?

[robgoldstein]

I have a cell that is substracting 30 minutes from the time displayed in another cell. In order to have this cell display a time I need to format that cell as time otherwise it displays it as a decimal. I have the this formula running for this cell =K2-$C$77 and when formatted as time it works very well for that cell.

I am then running a VBA macro to send a mail merge, and when I send the email that time cell is being coverted into a decimal in the mail.

Here is the text of the email I am receiving
Amit is playing on the Blue team this week. The game is on Saturday Dec 1st, at 1:00 pm. Please get to the field at 0.520833333333333
We are playing at Central Tech Stadium on field 1.
If you can't make it, please let us know ASAP.
Please Arrive 30 mins before the game
Central Tech Stadium is at =IF(J2=$H$54, $I$54, IF(J2=$H$55,$I$55, IF(J2=$H$56,$I$56, IF(J2=$H$57,$I$57,IF(J2=$H$58,$I$58, IF(J2=$H$59,$I$59, IF(J2=$H$60,$I$60,IF(J2=$H$61,$I$61))))))))
Here is a map: Google Maps.
THIS IS AN AUTOMATED EMAIL. PLEASE CONFIRM YOUR GAME ON TEAMSNAP. If there are any errors please let us know
See you on the field.


Here is the macro I am running

Sub SendWith_SMTP_Gmail2()
  'Works On Windows (Not Mac). Mac Users Should Use Zapier Integration
  'Created by Randy Austin www.ExcelForFreelancers.com
  Dim EmailMsg, EmailConf As Object, EmailFields As Variant, sh As Worksheet
  Dim Subj, Mess, LastName, FirstName, Team, GameDate, GameTime, GameLocation, Field, eMail, Attach As String
  Dim ContactRow, LastRow, SentCounter As Long, EmailUsr As String
  '
  EmailUsr = "sctoronto2011boys@gmail.com"
  'Attach = "c:\folder\file name.pdf"  'folder name and file name
  Set sh = Sheets("Roster")
  For ContactRow = 2 To 50
    If sh.Range("I" & ContactRow).Value <> "not scheduled this week" Then
      '
      Set EmailMsg = CreateObject("CDO.Message") 'CDO (Collaboration Data Objects) -Make sure you have the 'CDO For Windows' Library Selected
      Set EmailConf = CreateObject("CDO.Configuration")
      EmailConf.Load -1    ' Set CDO Source Defaults
      Set EmailFields = EmailConf.Fields
      With EmailFields
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .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/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = EmailUsr
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "2011soccer"
        .Update
      End With
      '
      Subj = sh.Range("B53").Value 'Email Subject
      Mess = sh.Range("B55").Value 'Email Message
      LastName = sh.Range("D" & ContactRow).Value
      FirstName = sh.Range("C" & ContactRow).Value
      eMail = sh.Range("M" & ContactRow).Value   'In column M you must have the email of each record.
      Team = sh.Range("H" & ContactRow).Value
      GameDate = sh.Range("I" & ContactRow).Value
      GameTime = sh.Range("K" & ContactRow).Value
      GameLocation = sh.Range("J" & ContactRow).Value
      Address = sh.Range("R" & ContactRow).Value
      Map = sh.Range("S" & ContactRow).Value
      Arrive = sh.Range("Q" & ContactRow).Value
      Field = sh.Range("L" & ContactRow).Value
      Subj = Replace(Subj, "#gamedate#", GameDate)
      Mess = Replace(Replace(Mess, "#firstname#", FirstName), "#lastname#", LastName)
      Mess = Replace(Replace(Mess, "#location#", GameLocation), "#team#", Team)
      Mess = Replace(Replace(Mess, "#gamedate#", GameDate), "#gametime#", GameTime)
      Mess = Replace(Mess, "#arrive#", Arrive)
      Mess = Replace(Mess, "#address#", Address)
      Mess = Replace(Mess, "#map#", Map)
      Mess = Replace(Mess, "#field#", Field)
      '
      With EmailMsg
        Set .Configuration = EmailConf
        .To = eMail
        .CC = ""
        .BCC = ""
        .From = EmailUsr
        .Subject = Subj
        If Attach <> Empty Then .AddAttachment Attach
        .textBody = Mess
        On Error Resume Next
        .Send
        On Error GoTo 0
      End With
      If Err.Number = 0 Then
        SentCounter = SentCounter + 1
        sh.Range("P" & ContactRow).Value = Now 'Set Send Date & Time
      Else
        sh.Range("P" & ContactRow).Value = "Error : " & Err.Number & " " & Err.Description
      End If
    End If
    'Cleanup
    Set EmailMsg = Nothing
    Set EmailConf = Nothing
    Set EmailFields = Nothing
  Next ContactRow
  MsgBox SentCounter & " Emails have been sent"
End Sub

 

[Special-K99]

You can replace this formula

Central Tech Stadium is at =IF(J2=$H$54, $I$54, IF(J2=$H$55,$I$55, IF(J2=$H$56,$I$56, IF(J2=$H$57,$I$57,IF(J2=$H$58,$I$58, IF(J2=$H$59,$I$59, IF(J2=$H$60,$I$60,IF(J2=$H$61,$I$61))))))))

with

=LOOKUP(2,1/((J2=$H$54:$H$61)),$I$54:$I$61)

 

[daverunt]

Hi,

Whichever cell is used as the time source and being converted to a decimal use .Text not .Value for the mail.
I think that's the line below..?

GameTime = sh.Range("K" & ContactRow).Text

 

[robgoldstein]

Thanks so much. Solves a minor problem, but the real problem is how I get that cell to send out a time and not a decimal in the mail merge.

 

[Special-K99]

Am no VBA expert but would it be this?

Arrive = Format(sh.Range("Q" & ContactRow).Value, "h:mm AM/PM")

 

[robgoldstein]

Dave,
You are a hero.
Thanks so much.

 

[robgoldstein]

SOLVED!