mysql:13569
From: <atakahashi@xxxxxxxxxx>
Date: Mon, 4 Dec 2006 09:48:53 +0900
Subject: [mysql 13569] Mysql の一意制約を判別する方法
OSのVER]:WINDOWS XP [VBのVER]:VISUAL BASIC6.0 [MysqlのVER]Version4.025 VB初心者の「じろう」ものです。 現在、VB ADO、データベースはMysql(Version4.025)で開発を行っております。 例外処理で一意制約エラーの判定文を作成したいのですが、 エラーコードが一意制約独自のものはありませんでした。 どうやって例外処理の判定文を作ればいいかご教授お願いします。 これはVBの掲示板で聞けばいいか分かりませんが、、、、 ソースを下記に記載いたします。 ******************************** Sub CSV取込処理_Click() Dim myrec As ADODB.Recordset Set myrec = New ADODB.Recordset Dim cn As ADODB.Connection Dim cnt As String Dim sql As String Dim i As Integer Dim myFileName Dim Fhiduke As Date Dim Thiduke As Date Dim suryou As Integer Dim intRet As Integer Dim strMsg As String On Error GoTo NormalErr Application.DisplayAlerts = False Fhiduke = Str(Cells(2, 2)) Thiduke = Str(Cells(2, 4)) cnt = "Provider=MSDASQL.1;Data Source=minipos_system" ' ダイアログを表示 myFileName = Application.GetOpenFilename( _ fileFilter:="CSV ファイル(*.CSV), *.CSV", _ Title:="ファイルを選択して下さい", MultiSelect:=False) If myFileName = False Then Exit Sub End If Workbooks.Open myFileName i = 1 Set cn = CreateObject("ADODB.Connection") cn.Open cnt On Error GoTo SqlErr cn.BeginTrans Do Until Cells(i, 3) = "MISC" suryou = Cells(i, 4) / 100 sql = "insert into 67ds.u_import(hiduke,jan_code,syohinmei,sum_suryo,sum_kingaku) values( '" & Str(Now()) & Cells(i, 7) & "' , '" & Cells(i, 1) & "' , '" & Cells(i, 3) & "' , '" & suryou & "' , '" & Cells(i, 6) & "');" cn.Execute (sql) i = i + 1 Loop cn.CommitTrans cn.Close On Error GoTo NormalErr MsgBox "CSVインポート処理は成功しました。" ActiveWorkbook.Close Kill myFileName intRet = MsgBox("日計表を印刷しますか?", vbYesNo) If intRet = vbYes Then sql = "Select m_syohin.code,m_syohin.syohinmei,m_syohin.kikakumei,u_import.sum_suryo,u_import.sum_kingaku ,u_import.hiduke From 67ds.u_import LEFT JOIN 67ds.m_syohin on u_import.jan_code = m_syohin.jan_code " sql = sql & " Where u_import.hiduke <= '" & Str(Now()) & "'" sql = sql & " Order by u_import.hiduke ,m_syohin.code2 , m_syohin.kikakumei " Workbooks.Add Cells(1, 3) = "指定日:" & Format$(CStr(Now()), "YYYY年MM月DD日") & "〜" & Format$(CStr(Now()), "YYYY年MM月DD日") Range("C1:F1").Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With Columns("C:C").EntireColumn.AutoFit Selection.Font.Bold = True Cells(1, 3).Select With Selection.Font .Name = "MS Pゴシック" .Size = 9 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleSingle .ColorIndex = xlAutomatic End With With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With myrec.Open sql, cnt If myrec.EOF = True Then Beep MsgBox "インポートされた売上情報にデータがありません。" ActiveWorkbook.Close Exit Sub End If myrec.MoveFirst Cells(1, 2).Select With Selection.Font .Name = "MS Pゴシック" .Size = 14 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Underline = xlUnderlineStyleSingle Rows("1:1").RowHeight = 36 Selection.Font.Bold = True Cells(2, 1).Value = "コード" Cells(2, 2).Value = "商品名" Cells(2, 3).Value = "規格" Cells(2, 4).Value = "合計数量" Cells(2, 5).Value = "合計金額" Cells(2, 6).Value = "日付" Range("A2:F2").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With i = 3 Do Until myrec.EOF = True Cells(i, 1) = myrec.Fields(0).Value Cells(i, 2) = myrec.Fields(1).Value If IsNull(myrec.Fields(2).Value) = True Or myrec.Fields(2).Value = "(null)" Then Cells(i, 3) = "" Else Cells(i, 3) = myrec.Fields(2).Value End If Cells(i, 4) = myrec.Fields(3).Value Cells(i, 5) = myrec.Fields(4).Value Cells(i, 5).Select Selection.NumberFormatLocal = "#,##0" Cells(i, 6) = myrec.Fields(5).Value Cells(i, 2).Select Selection.Font.Bold = True Range(Cells(i, 1), Cells(i, 6)).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With myrec.MoveNext i = i + 1 Loop Range(Cells(i, 1), Cells(i, 6)).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With Cells(i, 4).Select Selection.Font.Bold = True ActiveCell.FormulaR1C1 = "=SUM(R[-" & i - 3 & "]C:R[-1]C)" Cells(i, 5).Select Selection.Font.Bold = True ActiveCell.FormulaR1C1 = "=SUM(R[-" & i - 3 & "]C:R[-1]C)" Selection.NumberFormatLocal = "#,##0" Range(Cells(i, 1), Cells(i, 3)).Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With ActiveCell.FormulaR1C1 = "総合計" ActiveCell.Characters(1, 1).PhoneticCharacters = "ソウ" ActiveCell.Characters(2, 2).PhoneticCharacters = "ゴウケイ" myrec.Close Set myrec = Nothing Columns("A:A").EntireColumn.AutoFit Columns("B:B").EntireColumn.AutoFit Columns("C:C").EntireColumn.AutoFit Columns("D:D").EntireColumn.AutoFit Columns("E:E").EntireColumn.AutoFit Columns("F:F").EntireColumn.AutoFit Range("B1").Select ActiveCell.FormulaR1C1 = "日計表" ActiveCell.Characters(1, 3).PhoneticCharacters = "ニッケイヒョウ" Range("B1").Select With Selection.Font .Name = "MS Pゴシック" .Size = 16 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.Font.Bold = True Range("B1").Select ActiveCell.FormulaR1C1 = "日計表" With ActiveCell.Characters(Start:=1, Length:=3).Font .Name = "MS Pゴシック" .FontStyle = "太字" .Size = 16 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleSingle .ColorIndex = xlAutomatic End With ActiveCell.Characters(1, 3).PhoneticCharacters = "ニッケイヒョウ" Range("B1").Select With ActiveSheet.PageSetup .PrintTitleRows = "$1:$2" .PrintTitleColumns = "" End With ActiveSheet.PageSetup.PrintArea = "" With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "&D" .CenterFooter = "&P/&N" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.78740157480315) .RightMargin = Application.InchesToPoints(0.78740157480315) .TopMargin = Application.InchesToPoints(0.984251968503937) .BottomMargin = Application.InchesToPoints(0.984251968503937) .HeaderMargin = Application.InchesToPoints(0.511811023622047) .FooterMargin = Application.InchesToPoints(0.511811023622047) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .PrintQuality = 600 .CenterHorizontally = False .CenterVertically = False .Orientation = xlPortrait .Draft = False .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = 100 .PrintErrors = xlPrintErrorsDisplayed End With ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Range("A1").Select Else Exit Sub End If ActiveWorkbook.Close Exit Sub SqlErr: ' 一意制約エラー If CStr(Err.Number) = "-2147217900" Then MsgBox "登録されたデータは重複した可能性があります。日次処理を行い、既に データが登録されているか確認して下さい。" MsgBox Err.Description, vbOKOnly, "SQL番号" & CStr(Err.Number) cn.RollbackTrans cn.Close ActiveWorkbook.Close Kill myFileName Exit Sub Else MsgBox "SQLエラー:インポートに失敗しました。" cn.RollbackTrans cn.Close ActiveWorkbook.Close Exit Sub End If NormalErr: MsgBox "エラーが発生しました。" ActiveWorkbook.Close Exit Sub End Sub *******************************************