[前][次][番号順一覧][スレッド一覧]

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

*******************************************




[前][次][番号順一覧][スレッド一覧]