AW: ISIN prüfen + abspeichern
01.03.2017 03:50:48
littletramp
Hallo Claudia
Mit der verwendeten Regex-Prüfung wird nur kontrolliert, ob das Muster (Pattern) eingehalten ist. Dies heisst aber noch lange nicht, dass die ISIN korrekt ist (Ländercode und Prüfziffer werden nicht kontrolliert).
Gib mal XXXXXXXXXXX0 als ISIN ein. Ich versichere dir, dass dies keine korrekte ISIN ist, aber Antons Code wird diese als korrekt taxieren (Sorry Anton, dies ist nicht böse gemeint).
Ich habe dir hier eine Mappe hochgeladen, mit 2 Modulen https://www.herber.de/bbs/user/111852.xlsm
Beachte, dass das Modul modISIN unter GNU-Lizenz steht (lies Kommentar am Anfang des Moduls).
Code in modIsinPruefenUndSpeichern:
Option Explicit
Public Sub ISINPrüfenUndMappeSpeichern()
Dim strProdukt As String
Dim strIsin As String
Dim strDatei As String
Const cPath = "C:\Users\Claudia_PC\Desktop\Ordner\"
If ActiveWorkbook Is ThisWorkbook Then
MsgBox "Dies ist die Mappe mit dem Code!" & vbLf & vbLf _
& "Sie kann mit diesem Makro nicht" & vbLf _
& "gespeichert werden!", vbExclamation
Exit Sub
End If
strProdukt = Range("C3").Value
strIsin = Range("C4").Value
strDatei = cPath & strIsin & "_" & strProdukt & ".xlsx"
If IsIsin(strIsin) Then
On Error Resume Next
ActiveWorkbook.SaveAs Filename:=strDatei, ConflictResolution:=xlUserResolution
If Err.Number 0 Then
MsgBox "Die Datei wurde nicht gespeichert!", vbInformation
End If
On Error GoTo 0
Else
MsgBox "Die ISIN ist ungültig!"
End If
End Sub
Code in modISIN:
Option Explicit
' Quelle:
' http://www.jdawiseman.com/papers/ _
trivia/isin.html
' The code was written for Microsoft Excel, though should work in
' Access if prefixed with a line Attribute VB_Name = "modIsin".
' The original was © Julian D. A. Wiseman 2006 and 2007, though in
' 2009 was modified by Patrick Honorez of www.idevlop.com, primarily
' to replace Excel-specific code with more general code and to add
' the function IsIsin, and then further modified by Julian D.A.Wiseman.
' It may be distributed under the terms of the GNU General Public License.
' Occasionally kCountries3166 will need to be extended.
Const kCountries3166 = "AD;AE;AF;AG;AI;AL;AM;AN;AO;AQ;AR;AS;AT;AU;" _
& "AW;AX;AZ;BA;BB;BD;BE;BF;BG;BH;BI;BJ;BL;BM;" _
& "BN;BO;BR;BS;BT;BV;BW;BY;BZ;CA;CC;CD;CF;CG;" _
& "CH;CI;CK;CL;CM;CN;CO;CR;CU;CV;CX;CY;CZ;DE;" _
& "DJ;DK;DM;DO;DZ;EC;EE;EG;EH;ER;ES;ET;FI;FJ;" _
& "FK;FM;FO;FR;GA;GB;GD;GE;GF;GG;GH;GI;GL;GM;" _
& "GN;GP;GQ;GR;GS;GT;GU;GW;GY;HK;HM;HN;HR;HT;" _
& "HU;ID;IE;IL;IM;IN;IO;IQ;IR;IS;IT;JE;JM;JO;" _
& "JP;KE;KG;KH;KI;KM;KN;KP;KR;KW;KY;KZ;LA;LB;" _
& "LC;LI;LK;LR;LS;LT;LU;LV;LY;MA;MC;MD;ME;MF;" _
& "MG;MH;MK;ML;MM;MN;MO;MP;MQ;MR;MS;MT;MU;MV;" _
& "MW;MX;MY;MZ;NA;NC;NE;NF;NG;NI;NL;NO;NP;NR;" _
& "NU;NZ;OM;PA;PE;PF;PG;PH;PK;PL;PM;PN;PR;PS;" _
& "PT;PW;PY;QA;RE;RO;RS;RU;RW;SA;SB;SC;SD;SE;" _
& "SG;SH;SI;SJ;SK;SL;SM;SN;SO;SR;ST;SV;SY;SZ;" _
& "TC;TD;TF;TG;TH;TJ;TK;TL;TM;TN;TO;TR;TT;TV;" _
& "TW;TZ;UA;UG;UM;US;UY;UZ;VA;VC;VE;VG;VI;VN;" _
& "VU;WF;WS;XS;YE;YT;ZA;ZM;ZW"
' Given the first eleven characters of an ISIN, this calculates the twelfth character, the _
checksum.
' © Julian D. A. Wiseman 2006 to 2009; parts, including some de-Excel-isation, by and © Patrick _
Honorez of www.idevlop.com.
' Believed correct. If it doesnt always work then toughit is free.
' Latest version available via http: _
//www.jdawiseman.com/papers/trivia/isin.html
Public Function IsIsin(ByVal strIsin As Variant, Optional strCountries As String = _
kCountries3166) As Boolean
' Added by Patrick Honorez of www.idevlop.com
' Returns True if string looks like a valid ISIN, False otherwise
' Parameters: strIsin : ISIN to check, as a string (Null accepted)
' strCountries: optional list of countries. If not provided, default list will be _
used.
' if provided with empty string, this check will be bypassed
' Note: some checks are redundant, but are there for speed.
Const kIsinLike = "[A-Z][A-Z]?[0-9]"
Dim strCheck As String
If IsNull(strIsin) Then Exit Function ' Null values
If Len(strIsin) 12 Then Exit Function ' Will return False
If Not strIsin Like kIsinLike Then Exit Function ' Will return False
If Len(strCountries) > 0 Then ' Test country code ?
If InStr(1, strCountries, Left(strIsin, 2)) = 0 Then Exit Function
End If ' Len(strCountries) > 0
strCheck = LastDigitISIN(Left(strIsin, 11)) ' Check digit
If Not strCheck Like "[0-9]" Then Exit Function ' LastDigitIsin returned an error
If Right(strIsin, 1) = strCheck Then IsIsin = True
End Function ' IsIsin
Public Function LastDigitISIN(ElevenChars As String) As String
Dim i As Integer, CheckSumDigits As String, TotalScore As Integer, Char As String
If Len(ElevenChars) 11 Then
LastDigitISIN = "L" ' Length error
Exit Function
End If ' Len(ElevenChars) 11
CheckSumDigits = ""
For i = 1 To 11
Char = UCase(Mid(ElevenChars, i, 1))
If Char >= "0" And Char = "A" And Char 6 Then
LastDigitSEDOL = "L" ' Length error
Exit Function
End If ' Len(SixChars) > 6
For i = 1 To Len(SixChars)
Multiplier = Choose(i + 6 - Len(SixChars), 1, 3, 1, 7, 3, 9)
Char = UCase(Mid(SixChars, i, 1))
If Char >= "0" And Char = "A" And Char
Gruss Markus
