Date being converted to US

[danny8890]

Hi,

I have the below code extracting emails from outlook into excel. When i step through the code the string is being returned with the correct date format however, when its put into Excel it has been changed to US date... any suggestions?

I have checked my language settings and they are all correct.

Option Explicit
Sub CopyToExcel()
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim rCount As Long
Dim bXStarted As Boolean
Dim strPath As String


Dim currentExplorer As Explorer
Dim Selection As Selection
Dim olItem As Outlook.MailItem
Dim obj As Object
Dim strColA, strColB, strColC, strColD, strColE, strColF As String
               
' Get Excel set up


'the path of the workbook
strPath = "\\P:\Implementation\UTA\UTA - Raw.xlsm"
     On Error Resume Next
     Set xlApp = GetObject(, "Excel.Application")
     If Err <> 0 Then
         Application.StatusBar = "Please wait while Excel source is opened ... "
         Set xlApp = CreateObject("Excel.Application")
         bXStarted = True
     End If
     On Error GoTo 0
     'Open the workbook to input the data
     Set xlWB = xlApp.Workbooks.Open(strPath)
     Set xlSheet = xlWB.Sheets("Sheet1")
    ' Process the message record
    
    On Error Resume Next
'Find the next empty line of the worksheet
rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(-4162).Row
'needed for Exchange 2016. Remove if causing blank lines.
rCount = rCount + 1


' get the values from outlook
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
  For Each obj In Selection


    Set olItem = obj
    
 'collect the fields
    strColC = olItem.SenderEmailAddress
    strColA = olItem.Subject
    strColB = olItem.SenderName
    strColD = olItem.Body
    strColE = olItem.To
    strColF = olItem.ReceivedTime
    


' Get the Exchange address
' if not using Exchange, this block can be removed
Dim olEU As Outlook.ExchangeUser
Dim oEDL As Outlook.ExchangeDistributionList
Dim recip As Outlook.Recipient
Set recip = Application.Session.CreateRecipient(strColC)


If InStr(1, strColC, "/") > 0 Then
' if exchange, get smtp address
     Select Case recip.AddressEntry.AddressEntryUserType
       Case OlAddressEntryUserType.olExchangeUserAddressEntry
         Set olEU = recip.AddressEntry.GetExchangeUser
         If Not (olEU Is Nothing) Then
             strColC = olEU.PrimarySmtpAddress
         End If
       Case OlAddressEntryUserType.olOutlookContactAddressEntry
         Set olEU = recip.AddressEntry.GetExchangeUser
         If Not (olEU Is Nothing) Then
            strColC = olEU.PrimarySmtpAddress
         End If
       Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
         Set oEDL = recip.AddressEntry.GetExchangeDistributionList
         If Not (oEDL Is Nothing) Then
            strColC = olEU.PrimarySmtpAddress
         End If
     End Select
End If
' End Exchange section


'write them in the excel sheet
  xlSheet.Range("A" & rCount) = strColA
  xlSheet.Range("B" & rCount) = strColB
  xlSheet.Range("c" & rCount) = strColC
  xlSheet.Range("d" & rCount) = strColD
  xlSheet.Range("e" & rCount) = strColE
  xlSheet.Range("f" & rCount) = strColF
  
'Next row
  rCount = rCount + 1


Next


  With xlWB.Sheets(1)
    .Range("A:F").WrapText = False
    
End With


     xlWB.Close 1
     If bXStarted Then
         xlApp.Quit
     End If
    
     Set olItem = Nothing
     Set obj = Nothing
     Set currentExplorer = Nothing
     Set xlApp = Nothing
     Set xlWB = Nothing
     Set xlSheet = Nothing
     
     
' Show summary message
        MsgBox "Finished" _
    


    
 End Sub

 

[Special-K99]

Could this be related to Regional Locale settings and completely outside of your code?

 

[FormR]

Hi, try declaring the variable that holds the date as a date rather than a string.

btw - this syntax..

Dim strColA, strColB, strColC, strColD, strColE, strColF As String

..Is probably not doing what you think it is, only the last variable is declared as a string, all the others are the default variant type.

 

[Norie]

You could also try converting the 'text' date you have to a 'real' date using DateValue.

  xlSheet.Range("f" & rCount) = DateValue(strColF)

 

[danny8890]

Hi, try declaring the variable that holds the date as a date rather than a string.

btw - this syntax..

Dim strColA, strColB, strColC, strColD, strColE, strColF As String

..Is probably not doing what you think it is, only the last variable is declared as a string, all the others are the default variant type.

Your absolutely correct, i believe the ling of code to be all set as String, i've changed the ColF to Date and its worked without swapping the date!.

Thanks