badkatro
9/19/2017 - 12:39 PM
Outlook_BICDocDone_Confirm.vba
Attribute VB_Name = "BICDocDoneConfirm"
Sub Confirm_BICDoc_Done()
If Not GSCRo_Lib.IsClipboard_AListOf_CouncilDocuments Then
Dim soughtDocument As String
soughtDocument = InputBox("Confirm what RUE Document?", "No GSC Doc in Clipboard!")
If Not Is_GSC_Doc(GSC_StandardName_ToFileName(saughtDocument)) Then
MsgBox "Please provide a valid GSC Doc ID! Exiting..."
Exit Sub
Else ' already is std GSC name, but convert to non-WF format
soughtDocument = GSCFileName_ToStandardName(GSC_StandardName_ToFileName(saughtDocument))
End If
Else
' double pass to filename and back to standard name serves to transform to double digit year
soughtDocument = GSCFileName_ToStandardName(GSC_StandardName_ToFileName(Get_Clipboard_TextContents))
End If
Dim newMail As Outlook.MailItem
Set newMail = Application.CreateItem(olMailItem)
newMail.Subject = soughtDocument & " RESTREINT UE RO - FINISHED"
newMail.To = "COORDINATION BIC"
newMail.Body = "Dear colleagues, " & vbCr & vbCr & "Please be informed that the above-mentioned document, RO version, has been finished and may be found in the output folder on ROLAN." & vbCr & vbCr & _
"Greetings," & vbCr & GetOutlook_CurrentUser
newMail.Display
End Sub
Function GetOutlook_CurrentUser() As String
Dim myNamespace As Outlook.NameSpace
Set myNamespace = Application.GetNamespace("MAPI")
GetOutlook_CurrentUser = CStr(myNamespace.CurrentUser)
End Function
Function Is_GSC_Doc(FileName As String, Optional SilentMode) As Boolean
' version 0.6
' independent
' depends on VerificaCN
' 0.5 - Added XM, XN, XT
' 0.6 - Minding only first 2 groups of chars separated by dot.
Dim MsgS As String
Dim PointPos As Byte
Dim LinePos As Byte
Dim ff As New Scripting.FileSystemObject
' Is filename extensioned or not ? (".doc" extension)
If Right$(FileName, 5) = ".docx" Or Right$(FileName, 4) = ".doc" Then
' This way we ONLY look at
If UBound(Split(FileName, ".")) = 2 Then
BaseDocName = ff.GetBaseName(FileName)
Else
BaseDocName = Split(FileName, ".")(0) & "." & Split(FileName, ".")(1)
End If
Else
BaseDocName = FileName
End If
PointPos = InStr(1, BaseDocName, ".")
Select Case PointPos
Case 0
MsgS = "Not Council document, or not properly named! Cherish the point!"
Ooops: If IsMissing(SilentMode) Then
StatusBar = MsgS
End If
Is_GSC_Doc = False
Exit Function
Case Is = 8
LinePos = InStr(1, BaseDocName, "-", vbTextCompare)
If LinePos <> 0 And LinePos <= PointPos Then MsgS = _
"Not Council document, or not properly named! Where's your line at?": GoTo Ooops
Case Is > 9
If (PointPos - 9) Mod 4 <> 0 Then MsgS = _
"Not Council document, or not properly named! Where's your point at?": GoTo Ooops
LinePos = InStr(1, BaseDocName, "-", vbTextCompare)
If LinePos <> 8 Then MsgS = _
"Not Council document, or not properly named! Cherish your lines!": GoTo Ooops
Case Else
MsgS = "Not Council document, or not properly named! Where's your point at?": GoTo Ooops
End Select
Set ff = Nothing
DocType(0, 0) = "st": DocType(0, 7) = "cp"
DocType(0, 1) = "sn": DocType(0, 8) = "ad"
DocType(0, 2) = "cm": DocType(0, 9) = "ac"
DocType(0, 3) = "ds": DocType(0, 10) = "nc"
DocType(0, 4) = "lt": DocType(0, 11) = "np"
DocType(0, 5) = "bu": DocType(0, 12) = "da"
DocType(0, 6) = "pe": DocType(0, 13) = "rs"
DocType(0, 14) = "cg": DocType(0, 15) = "fa"
DocType(0, 16) = "xm": DocType(0, 17) = "xn"
DocType(0, 18) = "xt"
DocType(1, 0) = "1"
DocType(1, 1) = "2"
DocSuff(0, 0) = "re": DocSuff(0, 3) = "ex"
DocSuff(0, 1) = "co": DocSuff(0, 4) = "am"
DocSuff(0, 2) = "ad": DocSuff(0, 5) = "dc"
DocSuff(1, 0) = 8
DocSuff(1, 1) = PointPos - 8
ReDim DocYear(1, (Right$(DatePart("yyyy", Date), 2)) - 1) 'Ultimele doua cifre ale anului curent
j = -1
For i = Right$(DatePart("yyyy", Date), 2) To 1 Step -1
j = j + 1
DocYear(0, j) = Format(i, "00")
Next i
DocYear(1, 0) = PointPos + 3
DocYear(1, 1) = "2"
EUDocLang(0, 0) = "en": EUDocLang(0, 12) = "cs"
EUDocLang(0, 1) = "fr": EUDocLang(0, 13) = "et"
EUDocLang(0, 2) = "ro": EUDocLang(0, 14) = "lv"
EUDocLang(0, 3) = "de": EUDocLang(0, 15) = "lt"
EUDocLang(0, 4) = "nl": EUDocLang(0, 16) = "hu"
EUDocLang(0, 5) = "it": EUDocLang(0, 17) = "mt"
EUDocLang(0, 6) = "es": EUDocLang(0, 18) = "pl"
EUDocLang(0, 7) = "da": EUDocLang(0, 19) = "sk"
EUDocLang(0, 8) = "el": EUDocLang(0, 20) = "sl"
EUDocLang(0, 9) = "pt": EUDocLang(0, 21) = "bg"
EUDocLang(0, 10) = "fi": EUDocLang(0, 22) = "xx"
EUDocLang(0, 11) = "sv": EUDocLang(0, 23) = "hr"
EUDocLang(0, 24) = "ga" ' Rarer gaelic - irish
EUDocLang(1, 0) = PointPos + 1
EUDocLang(1, 1) = 2
For i = 1 To 5
If VerificaCN(i, BaseDocName) = False Then
MsgS = "Not Council Document, Sorry!"
GoTo Ooops
End If
Next i
Is_GSC_Doc = True
End Function
Function VerificaCN(VerifN, VString As String) As Boolean ' Verifica Council Name
' version 1.0
' independent
' Added "DCL" suffix to represent declasiffications
Dim CeVerificam
Dim EValid As Boolean, ENumeric As Boolean
Select Case VerifN
Case Is = 1
CeVerificam = DocType()
VLoop: For j = 0 To UBound(CeVerificam, 2)
If StrComp(Mid$(BaseDocName, CeVerificam(1, 0), CeVerificam(1, 1)), _
CeVerificam(0, j), vbTextCompare) = 0 Then
VerificaCN = True
Exit For
End If
Next j
Case Is = 2
If IsNumeric(Mid$(BaseDocName, 3, 5)) = True Then VerificaCN = True
Case Is = 3
If InStr(1, BaseDocName, "-", vbTextCompare) = 0 Then
VerificaCN = True
ElseIf InStr(1, BaseDocName, "-", vbTextCompare) = 8 Then
For n = 1 To (DocSuff(1, 1) - 1) / 4
EValid = False
For j = 0 To UBound(DocSuff, 2)
If StrComp(Mid$(BaseDocName, (8 + (4 * n - 3)), 2), DocSuff(0, j), vbTextCompare) = 0 Then
EValid = True
Exit For
End If
Next j
If EValid = False Then Exit For
Next n
For n = 1 To (DocSuff(1, 1) - 1) / 4
ENumeric = False
If IsNumeric(Mid$(BaseDocName, (8 + (4 * n - 1)), 2)) = True Then ENumeric = True
If ENumeric = False Then Exit For
Next n
If EValid = True And ENumeric = True Then VerificaCN = True
End If
Case Is = 4
CeVerificam = EUDocLang()
GoTo VLoop
Case Is = 5
CeVerificam = DocYear()
GoTo VLoop
End Select
End Function
Function IsClipboard_AListOf_CouncilDocuments() As Boolean ' Weird name, ha ? But descriptive enough ... ! :)
' Useful in a specific context, need to know if a list of Council document names represents the text portion of the clipboard or not !
Dim clipText As String
Dim gscDocNames As Variant
If Get_Clipboard_TextContents <> "" Then
clipText = Get_Clipboard_TextContents
' remove non-alpha numeric chars from beginning and end of input string
clipText = TrimNonAlphaNums(clipText)
If InStr(1, clipText, vbCr) > 0 Then
gscDocNames = Split(Trim(clipText), vbCr)
If IsArray(gscDocNames) Then
If UBound(gscDocNames) > 0 Then
' Clean strings from vbcr
For j = 0 To UBound(gscDocNames)
gscDocNames(j) = Replace(Replace(gscDocNames(j), Chr(13), ""), Chr(10), "")
Next j
' HERE, iterate through all elements in gscDocNames to check if they're ALL GSC documents or not
For j = 0 To UBound(gscDocNames)
If Is_GSC_Doc(GSC_StandardName_ToFileName(CStr(gscDocNames(j)))) Then
IsClipboard_AListOf_CouncilDocuments = True
Else
IsClipboard_AListOf_CouncilDocuments = False
Exit Function
End If
Next j
Else
MsgBox "gscDocNames Array is empty ! Please debug !" & vbcrcr & _
"Err number " & Err.Number & " occured in " & Err.Source & vbCr & Err.Description, vbOKOnly + vbCritical, "Error"
IsClipboard_AListOf_CouncilDocuments = False
Exit Function
End If
Else
' Error ?
End If
Else
' No enters in clipboard string ? Not multiple docs then, how about a single one?
gscDocNames = Replace(Replace(clipText, Chr(13), ""), Chr(10), "")
If Is_GSC_Doc(GSC_StandardName_ToFileName(CStr(gscDocNames))) Then
IsClipboard_AListOf_CouncilDocuments = True
Else
IsClipboard_AListOf_CouncilDocuments = False
End If
End If
Else
' MsgBox "Clipboard contains no text, sorry. Please re-copy the needed text", vbOKOnly + vbCritical, _
"Error, no text in clipboard"
' Function returns False
IsClipboard_AListOf_CouncilDocuments = False
End If
End Function
Function Get_Clipboard_TextContents() As String
On Error GoTo ErrorHandler
Dim clipText As String
Dim mydata As New MSForms.DataObject
mydata.GetFromClipboard ' get contents of clipboard into "mydata" data object
If mydata.GetFormat(1) Then ' format 1 means format text
clipText = mydata.GetText(1)
Else
clipText = "" ' clear variable, so that next if is able to thus expedite exit
End If
'
If clipText <> "" Then
Get_Clipboard_TextContents = clipText
Else
Get_Clipboard_TextContents = ""
End If
Exit Function
'**********************************************************************************************
ErrorHandler:
If Err <> 0 Then
MsgBox "Error " & Err.Number & " has occured in " & Err.Source & vbcrcr & _
"Error has following description: " & Err.Description, vbOKOnly + vbCritical, "Get_Clipboard_TextContents Error"
Err.Clear
Get_Clipboard_TextContents = ""
End If
End Function
Function Set_Clipboard_TextContents(NewClipText As String) As String
On Error GoTo ErrorHandler
Dim clipText As String
Dim mydata As New MSForms.DataObject
If NewClipText <> "" Then
mydata.SetText (NewClipText) ' set contents of clipboard using "mydata" data object
Else
mydata.SetText ""
End If
mydata.PutInClipboard
If Get_Clipboard_TextContents = NewClipText Then
Set_Clipboard_TextContents = NewClipText
Else
Set_Clipboard_TextContents = "Error Set_Clipboard_TextContents"
End If
Exit Function
'**********************************************************************************************
ErrorHandler:
If Err <> 0 Then
MsgBox "Error " & Err.Number & " has occured in " & Err.Source & vbcrcr & _
"Error has following description: " & Err.Description, vbOKOnly + vbCritical, "Get_Clipboard_TextContents Error"
Err.Clear
Set_Clipboard_TextContents = ""
End If
End Function
Function TrimNonAlphaNums(InputString As String) As String
Dim istr As String
istr = InputString
Do While Len(istr) > 0 And (Not Right$(istr, 1) Like "[a-zA-Z0-9]")
istr = Left$(istr, Len(istr) - 1)
Loop
Do While Len(istr) > 0 And (Not Left$(istr, 1) Like "[a-zA-Z0-9]")
istr = Mid$(istr, 2)
Loop
TrimNonAlphaNums = istr
End Function
Function GSCFileName_ToStandardName(FileName As String, Optional SpacedSuffix, Optional NoPrefixforST, Optional RevNumInDocNum) As String
' version 0.45
' independent
'
' Convert string representing gsc document filename to standard name (st12345.en12.doc to ST 12345/12)
' Added option to produce standard name with REV number before year, as in: st12345-re01.en13.doc -> ST 12345/1/13 REV1
' RevNumInDocNum can be set to
' 0 or "RevNumInSuffix", so as to NOT include rev number in doc number, list it as suffix, as in ST 12345/13 REV1
' or 1, or "RevNumInDocNum", so as to include it in doc number AND list it as suffix as well, example ST 12345/1/13 REV1
' or 2, or "RevNumInDocNumOnly", so as to include it ONLY in document number, not in suffix, example ST 12345/1/13
Dim SType As String, SNumber As String, SYear As String, SSuff As String
Dim SPointPos As Byte
SPointPos = InStr(1, FileName, ".")
SType = UCase(Left$(FileName, 2))
SNumber = Format(Mid$(FileName, 3, 5), "#####")
SYear = Mid$(FileName, SPointPos + 3, 2)
If SPointPos > 8 Then
If InStr(1, FileName, "-") > 0 Then
If Not IsMissing(SpacedSuffix) Then
If CStr(SpacedSuffix) = "True" Or LCase(CStr(SpacedSuffix)) = "spacedsuffix" Then
SSuff = Mid$(FileName, 9, (SPointPos - 9))
SSuff = SGC_Suff_ToStandard_Suff(SSuff)
ElseIf CStr(SpacedSuffix) = "False" Or LCase(CStr(SpacedSuffix)) = "nospacedsuffix" Then
SSuff = Mid$(FileName, 9, (SPointPos - 9))
SSuff = SGC_Suff_ToStandard_SuffNS(SSuff)
Else ' If spacedsuffix is wrongly specified, default is "no space" version
SSuff = Mid$(FileName, 9, (SPointPos - 9))
SSuff = SGC_Suff_ToStandard_SuffNS(SSuff)
End If
Else
' Non spaced suffix by default
SSuff = Mid$(FileName, 9, (SPointPos - 9))
SSuff = SGC_Suff_ToStandard_SuffNS(SSuff)
End If
End If
End If
' Handle revision number in doc number inclusion or not
If Not IsMissing(RevNumInDocNum) Then
Select Case LCase(CStr(RevNumInDocNum))
Case "0", "revnuminsuffix"
' No need to do, default behavious anyway
Case "1", "revnumindocnum"
If SSuff <> "" Then
SNumber = SNumber & "/" & IIf(InStr(1, SSuff, "REV"), Extr_Numbers(SSuff)(0), SNumber)
End If
Case "2", "revnumindocnumonly"
If SSuff <> "" Then
SNumber = SNumber & "/" & IIf(InStr(1, SSuff, "REV"), Extr_Numbers(SSuff)(0), SNumber)
' Now, that's an expression, ha ? Just had to do it !
SSuff = Trim(Replace(SSuff, Left$(SSuff, (IIf(Mid$(SSuff, 4, 1) = " ", 5, 4))), ""))
End If
Case Else
End Select
End If
' we assemble the final string, with or without suffix
If SSuff <> "" Then
GSCFileName_ToStandardName = SType & " " & SNumber & "/" & SYear & " " & UCase(SSuff)
Else
GSCFileName_ToStandardName = SType & " " & SNumber & "/" & SYear
End If
' We correct prefix (document type) as per user request (discard it for ST docs)
If Not IsMissing(NoPrefixforST) Then
' Any value will do, such as the name of parameter itself, or true or 1
If SType = "ST" Then
GSCFileName_ToStandardName = Replace(GSCFileName_ToStandardName, "ST ", "")
Else
End If
Else ' If parameter is missing, default behaviour is to leave prefix in
End If
End Function
Function GSC_StandardName_ToFileName(StandardName As String, Optional DocLanguage, Optional WithFileExtension) As String
' version 0.81
' Converts a standard document name to GSC filename as in "ST 12345/12 ADD1 REV2" to "st12345-ad01re02.en12"
' 0.70: corrected grave error in which it did not know to handle doc id such as 12536/1/12 (to result in st12536-re01.xx12),
' because it did not recognize that revision number may be embedded in the number-year string, or type-number-year string
' 0.71: made it not fail if supplied with arbitrary string
' 0.72: add poss to
' 0.8: added handling of short compounded suffixes, Workflow style: "RE1CO1" is now legal!
' 0.81: function not recognising "AD 16/2016", but same works for "SN" or "ST" !
Dim SType As String, SNumber As String, SYear As String, SSuff As String, SLng As String
Dim StdNameArr() As String
Dim ERevisionNum As String ' Embedded revision number
' Sanity check
If InStr(1, StandardName, "/") = 0 Then
GSC_StandardName_ToFileName = ""
Exit Function
End If
' If user provides language, use it
If Not IsMissing(DocLanguage) Then
SLng = LCase(DocLanguage)
Else
SLng = "xx"
End If
' Eliminate hard spaces and change multiple spaces to single, just in case
' (second case should not happend, but first probably will)
If InStr(1, Chr(160)) > 0 Then
StandardName = UCase(Replace(StandardName, Chr(160), " ")) ' Chr(160) is "non-breaking space"
End If
' Now replace multiple spaces to single
Do While InStr(1, StandardName, " ") > 0 ' Loop while two spaces
' InStr(1, " ") > 0 Then
StandardName = UCase(Replace(StandardName, " ", " "))
Loop
If InStr(1, StandardName, " ") > 0 Then
' Eliminate spaces in suffixes if present
StandardName = UCase(StandardName)
Dim stNameSuffixesPart As String
stNameSuffixesPart = Split(StandardName, "/")(1)
stNameSuffixesPart = Replace(Replace(Replace(stNameSuffixesPart, "REV ", "REV"), "COR ", "COR"), "ADD ", "ADD")
stNameSuffixesPart = Trim(Replace(Replace(Replace(stNameSuffixesPart, "AMD ", "AMD"), "EXT ", "EXT"), "DCL ", "DCL"))
stNameSuffixesPart = Replace(Replace(Replace(stNameSuffixesPart, "RE ", "RE"), "CO ", "CO"), "AD ", "AD")
stNameSuffixesPart = Trim(Replace(Replace(Replace(stNameSuffixesPart, "AM ", "AM"), "EX ", "EX"), "DC ", "DC"))
' and build back whole standard name, suffixes processed
StandardName = Split(StandardName, "/")(0) & "/" & stNameSuffixesPart
' Replace short suffixes with long suffixes!
' for AD, we cannot contend with ANY place found for DOC TYPE ! It has to ne NOT at the beginning !
If InStr(1, stNameSuffixesPart, "RE") > 0 And InStr(1, stNameSuffixesPart, "REV") = 0 Or _
InStr(1, stNameSuffixesPart, "CO") > 0 And InStr(1, stNameSuffixesPart, "COR") = 0 Or _
InStr(1, stNameSuffixesPart, "AD") > 1 And InStr(1, stNameSuffixesPart, "ADD") = 0 Or _
InStr(1, stNameSuffixesPart, "AM") > 0 And InStr(1, stNameSuffixesPart, "AMD") = 0 Or _
InStr(1, stNameSuffixesPart, "EX") > 0 And InStr(1, stNameSuffixesPart, "EXT") = 0 Or _
InStr(1, stNameSuffixesPart, "DC") > 0 And InStr(1, stNameSuffixesPart, "DCL") = 0 Then
' Elongate suffixes back to original form !
stNameSuffixesPart = Replace(Replace(Replace(stNameSuffixesPart, "RE", "REV"), "CO", "COR"), "AD", "ADD")
stNameSuffixesPart = Trim(Replace(Replace(Replace(stNameSuffixesPart, "AM", "AMD"), "EX", "EXT"), "DC", "DCL"))
' In this situation (short WF suffixes), we have no space separation between diff suffixes present in compound suffixes block ! ("RE1CO1")
stNameSuffixesPart = Replace(Replace(Replace(stNameSuffixesPart, "REV", " REV"), "COR", " COR"), "ADD", " ADD")
stNameSuffixesPart = Trim(Replace(Replace(Replace(stNameSuffixesPart, "AMD", " AMD"), "EXT", " EXT"), "DCL", " DCL"))
' and build back whole standard name, suffixes processed
StandardName = Split(StandardName, "/")(0) & "/" & stNameSuffixesPart
' Now replace multiple spaces to single
Do While InStr(1, StandardName, " ") > 0 ' Loop while two spaces
' InStr(1, " ") > 0 Then
StandardName = UCase(Replace(StandardName, " ", " "))
Loop
End If
StdNameArr = Split(Trim(StandardName), " ") ' 0-based array, 'cause result of split function
Else
ReDim StdNameArr(0)
StdNameArr(0) = StandardName
End If
' Did the string contain spaces or not? (compulsory that it does, obviously)
If UBound(StdNameArr) = 0 Then
If InStr(1, StdNameArr(0), "/") > 0 Then ' have year, user supplied
If UBound(Split(StdNameArr(0), "/")) = 2 Then ' We have a revision number embedded within doc number, no suffix
If IsNumeric(Split(StdNameArr(0), "/")(0)) And _
IsNumeric(Split(StdNameArr(0), "/")(1)) And _
IsNumeric(Split(StdNameArr(0), "/")(2)) And _
Len(Split(StdNameArr(0), "/")(2)) = 2 Then
SType = "st"
SNumber = Format(Split(StdNameArr(0), "/")(0), "00000")
SYear = Format(Split(StdNameArr(0), "/")(2), "00")
SSuff = "re" & Format(Split(StdNameArr(0), "/")(1), "00")
Else
GSC_StandardName_ToFileName = "" ' failure, these are necessary conditions
Exit Function
End If
Else ' No revision number embedded within doc number, no suffix
' Simplest of cases, one word supplied, doc number/ year, no suffixes
If IsNumeric(Split(StdNameArr(0), "/")(0)) And _
(IsNumeric(Split(StdNameArr(0), "/")(1)) And _
Len(Split(StdNameArr(0), "/")(1)) = 2) Then
SType = "st"
SNumber = Format(Split(StdNameArr(0), "/")(0), "00000")
SYear = Format(Split(StdNameArr(0), "/")(1), "00")
SSuff = ""
Else
GSC_StandardName_ToFileName = "" ' failure, these are necessary conditions
Exit Function
End If
End If
Else ' we add current year !
SType = "st"
SNumber = Format(StdNameArr(1), "00000")
SYear = Right$(Trim(Year(Now)), 2) ' two last digits of current year
SSuff = "" ' only two items is array, first being gsc doc type
End If
Else ' StdNameArr contains multiple items
If CleanGSC_DocType(StdNameArr(0)) <> "" Then ' First item is gsc doc type
StdNameArr(0) = CleanGSC_DocType(StdNameArr(0))
If UBound(StdNameArr) = 1 Then ' Then there's no suffix
' Did the user supply year with number or not?
If InStr(1, StdNameArr(1), "/") > 0 Then ' have year, user supplied
If UBound(Split(StdNameArr(1), "/")) = 2 Then ' We have a revision number embedded within doc number
If IsNumeric(Split(StdNameArr(1), "/")(0)) And _
IsNumeric(Split(StdNameArr(1), "/")(1)) And _
IsNumeric(Split(StdNameArr(1), "/")(2)) And _
(Len(Split(StdNameArr(1), "/")(2) = 2 Or Len(Split(StdNameArr(1), "/")(2)) = 4)) Then
ERevisionNum = "re" & Format(Split(StdNameArr(1), "/")(1), "00")
SType = LCase(StdNameArr(0))
SNumber = Format(Split(StdNameArr(1), "/")(0), "00000")
If Len(Split(StdNameArr(1), "/")(2)) = 4 Then
SYear = Format(Right(Split(StdNameArr(1), "/")(2), 2), "00")
Else
SYear = Format(Split(StdNameArr(1), "/")(2), "00")
End If
SSuff = "" ' No suffix in array StdNameArr
Else
GSC_StandardName_ToFileName = "" ' failure, these are necessary conditions
Exit Function
End If
Else ' No embedded revision number
If IsNumeric(Split(StdNameArr(1), "/")(0)) And _
(IsNumeric(Split(StdNameArr(1), "/")(1)) And _
(Len(Split(StdNameArr(1), "/")(1)) = 2 Or Len(Split(StdNameArr(1), "/")(1)) = 4)) Then
If Len(Split(StdNameArr(1), "/")(1)) = 4 Then
SYear = Format(Right(Split(StdNameArr(1), "/")(1), 2), "00")
Else
SYear = Format(Split(StdNameArr(1), "/")(1), "00")
End If
SType = LCase(StdNameArr(0))
SNumber = Format(Split(StdNameArr(1), "/")(0), "00000")
SSuff = ""
Else
GSC_StandardName_ToFileName = "" ' failure, these are necessary conditions
Exit Function
End If
End If
Else ' we add current year !
SType = LCase(StdNameArr(0))
SNumber = Format(StdNameArr(1), "00000")
SYear = Right$(Trim(Year(Now)), 2) ' two last digits of current year
SSuff = "" ' only two items is array, first being gsc doc type
End If
Else ' There's at least one suffix
If InStr(1, StdNameArr(1), "/") > 0 Then ' have year, user supplied
If UBound(Split(StdNameArr(1), "/")) = 2 Then ' We have a revision number embedded within doc number
If IsNumeric(Split(StdNameArr(1), "/")(0)) And _
IsNumeric(Split(StdNameArr(1), "/")(1)) And _
IsNumeric(Split(StdNameArr(1), "/")(2)) And _
Len(Split(StdNameArr(1), "/")(2)) = 2 Then
ERevisionNum = "re" & Format(Split(StdNameArr(1), "/")(1), "00")
SType = LCase(StdNameArr(0))
SNumber = Format(Split(StdNameArr(1), "/")(0), "00000")
SYear = Format(Split(StdNameArr(1), "/")(2), "00")
Else
GSC_StandardName_ToFileName = "" ' failure, these are necessary conditions
Exit Function
End If
Else ' No revision number embedded in doc number
If IsNumeric(Split(StdNameArr(1), "/")(0)) And _
(IsNumeric(Split(StdNameArr(1), "/")(1)) And _
(Len(Split(StdNameArr(1), "/")(1)) = 2 Or Len(Split(StdNameArr(1), "/")(1)) = 4)) Then
' allow for also using format from jobslip into this function (ie SN 1073/2015 ADD1)
If Len(Split(StdNameArr(1), "/")(1)) = 4 Then
SYear = Format(Right$(Split(StdNameArr(1), "/")(1), 2), "00")
Else
SYear = Format(Split(StdNameArr(1), "/")(1), "00")
End If
SType = LCase(StdNameArr(0))
SNumber = Format(Split(StdNameArr(1), "/")(0), "00000")
Else
GSC_StandardName_ToFileName = "" ' failure, these are necessary conditions
Exit Function
End If
End If
Else ' we add current year !
SType = LCase(StdNameArr(0))
SNumber = StdNameArr(1)
SYear = Right$(Trim(Year(Now)), 2) ' two last digits of current year
End If
' And now, gather suffixes
For j = 1 To UBound(StdNameArr) - 1 ' elements 0 & 1 are excluded, we only count from there on
If CleanGSC_DocSuffix(StdNameArr(j + 1)) <> "" Then
SSuff = SSuff & SGC_StdSuff_To_FileSuff(CleanGSC_DocSuffix(StdNameArr(j + 1)))
Else
GSC_StandardName_ToFileName = "" ' failure, these are necessary conditions
Exit Function
End If
Next j
If ERevisionNum <> "" Then
End If
End If
Else ' gotta be number/year then, ha ?
' ******************************************************************************
' FIRST ITEM IS NUMBER/ YEAR, THERE'S AT LEAST ONE SUFFIX !
' ******************************************************************************
' Do we have user supplied year ? (Hopefully)
If InStr(1, StdNameArr(0), "/") > 0 Then ' have year, user supplied
If UBound(Split(StdNameArr(0), "/")) = 2 Then ' We have a revision number embedded within doc number, no suffix
If IsNumeric(Split(StdNameArr(0), "/")(0)) And _
IsNumeric(Split(StdNameArr(0), "/")(1)) And _
IsNumeric(Split(StdNameArr(0), "/")(2)) And _
Len(Split(StdNameArr(0), "/")(2)) = 2 Then
ERevisionNum = "re" & Format(Split(StdNameArr(0), "/")(1), "00")
SType = "st"
SNumber = Format(Split(StdNameArr(0), "/")(0), "00000")
SYear = Format(Split(StdNameArr(0), "/")(2), "00")
Else
GSC_StandardName_ToFileName = "" ' failure, these are necessary conditions
Exit Function
End If
Else ' No revision number embedded in doc number
If IsNumeric(Split(StdNameArr(0), "/")(0)) And _
(IsNumeric(Split(StdNameArr(0), "/")(1)) And _
Len(Split(StdNameArr(0), "/")(1)) = 2) Then
SType = "st"
SNumber = Format(Split(StdNameArr(0), "/")(0), "00000")
SYear = Format(Split(StdNameArr(0), "/")(1), "00")
Else
GSC_StandardName_ToFileName = "" ' failure, these are necessary conditions
Exit Function
End If
End If
Else ' we add current year !
SType = "st"
SNumber = StdNameArr(0)
SYear = Right$(Trim(Year(Now)), 2) ' two last digits of current year
End If
' And now, gather suffixes
For j = 1 To UBound(StdNameArr) ' elements 0 & 1 are excluded, we only count from there on
If CleanGSC_DocSuffix(StdNameArr(j)) <> "" Then
SSuff = SSuff & SGC_StdSuff_To_FileSuff(CleanGSC_DocSuffix(StdNameArr(j)))
Else
GSC_StandardName_ToFileName = "" ' failure, these are necessary conditions
Exit Function
End If
Next j
End If
End If
' If first suffix is not a rev, we need add
If SSuff <> "" And Left(SSuff, 2) <> "re" Then
If ERevisionNum <> "" Then
SSuff = ERevisionNum & SSuff
End If
ElseIf SSuff = "" And ERevisionNum <> "" Then
SSuff = ERevisionNum
End If
' Did user request the file name result to have an extension or not ?
If Not IsMissing(WithFileExtension) Then
If SSuff <> "" Then
GSC_StandardName_ToFileName = SType & SNumber & "-" & SSuff & "." & SLng & SYear & ".doc"
Else
GSC_StandardName_ToFileName = SType & SNumber & "." & SLng & SYear & ".doc"
End If
Else
If SSuff <> "" Then
GSC_StandardName_ToFileName = SType & SNumber & "-" & SSuff & "." & SLng & SYear
Else
GSC_StandardName_ToFileName = SType & SNumber & "." & SLng & SYear
End If
End If
Exit Function
ErrorHandler:
' error handling code
End Function