I have a VBA function, designed for MS Access rather than Excel, but it should be reasonably easy to modify for Excel. Might even work as is. I think I merely recoded the stored procedure which R6 uses in VBA rather than T-SQL. The code is belo9w.
Now that I look at it though, it converts from R6 vague date to a string, so the input parameters are two long integers and a string rather than two dates and a string. So you will need another function to convert from your dates into R6 vague date integers.
Which makes me think, if you convert your start and end dates into strings and concatenate them with a hyphen between e.g. "01/01/2011 - 31/12/2011" the R6 import wizard ought to be able to process this.
Public Function BuildRecorderDateString(ByVal VagueDateStart, ByVal VagueDateEnd As Long, ByVal VagueDateType As String) As String
Dim MM1, MM2, RP1, RDS1, RDS2, RMS1, RMS2, VD As String
Dim Z, G, H, A, B, Y, C, M, D, RD, Y4, RD1, RM1, RY1, RD2, RM2, RY2, X, CC1, CC2 As Long
X = 0
Do While X < 2
VD = VagueDateType
RD = VagueDateStart + 693594
If X > 0 Then RD = VagueDateEnd + 693594
Z = RD + 306
H = 100 * Z - 25
A = Int(H / 3652425)
B = A - Int(A / 4)
Y = Int((100 * B + H) / 36525)
C = B + Z - 365 * Y - Int(Y / 4)
M = Int((5 * C + 456) / 153)
G = Int((153 * M - 457) / 5)
D = C - G
If M > 12 Then
Y = Y + 1
M = M - 12
End If
If X = 0 Then
RD1 = D
RM1 = M
RY1 = Y
CC1 = Int(Y / 100) + 1
If RD1 < 10 Then
RDS1 = "0" & Trim(Str(RD1))
Else
RDS1 = Trim(Str(RD1))
End If
If RM1 < 10 Then
RMS1 = "0" + Trim(Str(RM1))
Else
RMS1 = Trim(Str(RM1))
End If
Else
RD2 = D
RM2 = M
RY2 = Y
CC2 = Int(Y / 100)
If RD2 < 10 Then
RDS2 = "0" + Trim(Str(RD2))
Else
RDS2 = Trim(Str(RD2))
End If
If RM2 < 10 Then
RMS2 = "0" & Trim(Str(RM2))
Else
RMS2 = Trim(Str(RM2))
End If
End If
X = X + 1
Loop
Select Case RM1
Case 1
MM1 = "January"
Case 2
MM1 = "February"
Case 3
MM1 = "March"
Case 4
MM1 = "April"
Case 5
MM1 = "May"
Case 6
MM1 = "June"
Case 7
MM1 = "July"
Case 8
MM1 = "August"
Case 9
MM1 = "September"
Case 10
MM1 = "October"
Case 11
MM1 = "November"
Case 12
MM1 = "December"
End Select
Select Case RM2
Case 1
MM2 = "January"
Case 2
MM2 = "February"
Case 3
MM2 = "March"
Case 4
MM2 = "April"
Case 5
MM2 = "May"
Case 6
MM2 = "June"
Case 7
MM2 = "July"
Case 8
MM2 = "August"
Case 9
MM2 = "September"
Case 10
MM2 = "October"
Case 11
MM2 = "November"
Case 12
MM2 = "December"
End Select
RP1 = Trim(Str(RD1)) & "/" & Trim(Str(RM1)) & "/" & Trim(Str(RY1))
Select Case VD
Case "D"
RP1 = RDS1 & "/" & RMS1 & "/" & Trim(Str(RY1))
Case "DD"
RP1 = RDS1 & "/" & RMS1 & "/" & Trim(Str(RY1)) & " - " & RDS2 & "/" & RMS2 & "/" & Trim(Str(RY2))
Case "O"
RP1 = MM1 & "/" & Trim(Str(RY1))
Case "OO"
RP1 = MM1 & "/" & Trim(Str(RY1)) & " - " & MM2 & " " & Trim(Str(RY2))
Case "Y"
RP1 = Trim(Str(RY1))
Case "YY"
RP1 = Trim(Str(RY1)) & " - " & Trim(Str(RY2))
Case "-Y"
RP1 = " - " & Trim(Str(RY2))
Case "Y-"
RP1 = Trim(Str(RY1)) & " - "
Case "C"
RP1 = Trim(Str(CC1)) & "c"
Case "CC"
RP1 = Trim(Str(CC1)) & "c - " & Trim(Str(CC2)) & "c"
Case "-C"
RP1 = " - " + Trim(Str(CC2)) & "c"
Case "C-"
RP1 = Trim(Str(CC2)) & "c - "
Case "U"
RP1 = "Unknown"
End Select
If VD = "P" Or VD = "S" Then
If RM2 = 2 Then RP1 = "Winter"
If RM2 = 8 Then RP1 = "Summer"
If RM2 = 11 Then RP1 = "Autumn"
If RM2 = 5 Then RP1 = "Spring"
If VD = "P" Then RP1 = RP1 & " " & Trim(Str(RY2))
End If
BuildRecorderDateString = RP1
End Function
Rob Large
Wildlife Sites Officer
Wiltshire & Swindon Biological Records Centre