Excel'den MySQL'e veri aktarma

[Mahmut Bayram]

Bu bir alıntıdır Hüseyin Demirağ'dan
Excel Dosyalarını MySQL'e aktarma
MySQL ve Visual Basic makalelerimin 3'üçüncüsünde Excel dosyalarını MySQL'e aktarmayı anlatmaya çalışacağım
Visual Basic'te yeni bir proje açın ve 3 adet Form ekleyin.
Form1'in adını ExcelToMysqlAnafrm olarak değiştirin.
Form2'nin adını ExcelToMysqltablosecfrm olarak degistirin
Form3'ün adını ExcelToMysqlprogressfrm olarak degistirin
ExcelToMysqlAnafrm formuna 4 adet Button, 5 adet Text kutusu ve 1 adet Commondialog nesnesi yerleştirin.
ExcelToMysqlprogressfrm formuna 1 adet label(adı:labeldurum), ve 1 adet progressbar(adırogress) yerleştirin.
Text kutularından birisini txtMessage olarak değiştirin ve aşağıdaki kodları birinci forma yani ExcelToMysqlanafrm'ye yapıştırın.

Projenizle aynı dizin içerisine odbc_info.txt dosyasını boş olarak açın.İleride içerisine Odbc ayarları kaydedilecek.

'//////////Kod başlangıcı////////////////
Private Enum StepProcess
XLS_SELECTION = 1
ODBC_SETTING = 2
CHECKING_INFO = 3
COMPLETE_PROCESS = 4
End Enum

' Message ayarları '

Private Const strTitle = "ExcelToMysql"
Private Const strExitMsg = "Çıkmak istiyormusunuz?"
Private Const strReqDsnMsg = "ODBC ayarlarını girin"
Private Const strReqTableMsg = "Tablo adını girmelisin!"
Private Const strErrNotExistCols = "Excel dosyasındaki sütunlar ile MySQL tablo sütunları uyuşmuyor!"
Private Const strErrNotExistRows = "Excel dosyasındaki satırları ile MySQL tablo satırları uyuşmuyor!"
Private Const strNotExistTable = "Tablo veritabanında yok."


' SQL Sorgu

Private Const SQL_ORIGINAL = "INSERT INTO <TABLENAME> (<FIELDSET>VALUES (<VALUESET>"



Dim g_step As StepProcess
Dim g_excelFilename As String
Dim g_DSN As String
Dim g_UID As String
Dim g_PWD As String
Dim g_Table As String
Dim g_conn As ADODB.Connection
Dim g_rs As ADODB.Recordset
Dim xl As Excel.Application
Dim xl_worksheet As Excel.Worksheet
Dim xl_workbook As Excel.Workbook
Public strSelectedTablename As String


Private Sub Command1_Click()

If g_step = XLS_SELECTION Then
CommonDialog.Filter = "Excel Dosyaları|*.xls"
CommonDialog.ShowOpen
If CommonDialog.FileName = "" Then Exit Sub
g_step = ODBC_SETTING ' Next procedure
g_excelFilename = CommonDialog.FileName
Command3.Enabled = True
Call ShowTextMessage


ElseIf g_step = ODBC_SETTING Then
g_DSN = Text1.Text
g_UID = Text2.Text
g_PWD = Text3.Text
g_Table = Text4.Text
' boşlukları kaldırılıyor
g_DSN = Trim(g_DSN)
g_UID = Trim(g_UID)
g_PWD = Trim(g_PWD)
g_Table = Trim(g_Table)

If Len(g_DSN) = 0 Then
MsgBox strReqDsnMsg, vbOKOnly, strTitle
Exit Sub
ElseIf Len(g_Table) = 0 Then
MsgBox strReqTableMsg, vbOKOnly, strTitle
Exit Sub
End If

' ODBC ayarları kaydediliyor

Open App.Path & "\odbc_info.txt" For Output As #1
'ODBC_info txt dosyasına ayarlar kaydediliyor. Print #1, g_DSN
Print #1, g_UID
Print #1, g_PWD
Print #1, g_Table
Close #1

g_step = CHECKING_INFO
Call ShowTextMessage

ElseIf g_step = CHECKING_INFO Then
Dim bExistTable As Boolean
Dim source As String
Dim dummy As String
Dim SQL As String
Dim SQL_EXECUTION As String
Dim status As String

Dim cols_count As Long
Dim rows_count As Long
Dim data_value As String
Dim i As Long
Dim j As Long
Dim myTableName As String

source = "DSN=%1%;UID=%2%;PWD=%3%;"
source = Replace(source, "%1%", g_DSN)
source = Replace(source, "%2%", g_UID)
source = Replace(source, "%3%", g_PWD)

' "ADODB" nesnesi oluşturuluyor
Set g_conn = CreateObject("ADODB.Connection")
Set g_rs = CreateObject("ADODB.Recordset")

' ODBCye bağlanılıyor
g_conn.Open source

' tablo kontrol ediliyor
SQL_EXECUTION = "show tables"
g_rs.Open SQL_EXECUTION, g_conn
bExistTable = False
Do While Not g_rs.EOF
myTableName = CStr(g_rs(0))
If UCase(myTableName) = UCase(g_Table) Then
bExistTable = True
Exit Do
End If
g_rs.MoveNext
Loop
g_rs.Close

If bExistTable = False Then
MsgBox strNotExistTable, vbOKOnly, strTitle
xl.ActiveWorkbook.Close savechanges:=False
xl.Quit

g_conn.Close

Set g_rs = Nothing
Set g_conn = Nothing

Exit Sub
End If


exceltoMysqlProgressfrm.Show
Set xl = CreateObject("excel.application")
xl.Workbooks.Open g_excelFilename
xl.Visible = False

On Error GoTo handler

'Burası excelin ilk sayfasını dikkate alıyor. Siz sayfa ismi veya başka bir sıra vermek isterseniz xl.(Worksheets(1) kısmını
'sayfa2 veya (2) diye değiştirebilirsiniz. Set xl_worksheet = xl.Worksheets(1)
cols_count = GetColumnCount
rows_count = GetRowsCount

If cols_count = 0 Then
MsgBox strErrNotExistCols, vbOKOnly, strTitle

xl.ActiveWorkbook.Close savechanges:=False
xl.Quit

Set xl = Nothing
Set xl_worksheet = Nothing

Exit Sub
End If
If rows_count < 2 Then
MsgBox strErrNotExistRows, vbOKOnly, strTitle

xl.ActiveWorkbook.Close savechanges:=False
xl.Quit

Set xl = Nothing
Set xl_worksheet = Nothing

Exit Sub
End If

dummy = ""
For j = 1 To cols_count
dummy = dummy & xl_worksheet.Cells(1, j) & ","
Next

If Not dummy = "" Then
dummy = Left(dummy, Len(dummy) - 1)
End If

SQL = SQL_ORIGINAL
SQL = Replace(SQL, "<TABLENAME>", g_Table)
SQL = Replace(SQL, "<FIELDSET>", dummy)

DoEvents

exceltoMysqlProgressfrm.Progress.Min = 2
exceltoMysqlProgressfrm.Progress.Max = rows_count + 1

For i = 2 To rows_count

SQL_EXECUTION = SQL

dummy = ""
For j = 1 To cols_count
Debug.Print "*"
data_value = xl_worksheet.Cells(i, j)
Debug.Print data_value
data_value = Replace(data_value, "'", "''")
dummy = dummy & "'" & data_value & "',"
Next

If Not dummy = "" Then
dummy = Left(dummy, Len(dummy) - 1)
End If

SQL_EXECUTION = Replace(SQL_EXECUTION, "", dummy)

status = SQL_EXECUTION
If Len(status) > 100 Then
status = Left(status, 100)
End If
exceltoMysqlProgressfrm.labeldurum.Caption = "İşlem : " & status
exceltoMysqlProgressfrm.labProgress.Caption = FormatPercent(i / rows_count)
exceltoMysqlProgressfrm.Progress.Value = i + 1

Debug.Print SQL_EXECUTION
g_conn.Execute SQL_EXECUTION
Next

g_conn.Close
Set g_conn = Nothing
Set g_rs = Nothing

xl.ActiveWorkbook.Close savechanges:=False
xl.Quit
Unload exceltoMysqlProgressfrm
'Tamamlandı
g_step = COMPLETE_PROCESS
Call ShowTextMessage
Command3.Enabled = False
Command1.Caption = "Kapat"
Command2.Visible = False

ElseIf g_step = COMPLETE_PROCESS Then

'End
Unload Me

End If

Exit Sub
handler:
MsgBox Err.Description, vbCritical + vbOKOnly, "Error Message"
xl.ActiveWorkbook.Close savechanges:=False
xl.Quit
Unload exceltoMysqlProgressfrm

End Sub

Private Sub Command2_Click()
If MsgBox(strExitMsg, vbYesNo, strTitle) = vbYes Then
Unload Me
End If
End Sub

Private Sub Command3_Click()
If g_step = ODBC_SETTING Then
Command3.Enabled = False
g_step = XLS_SELECTION
ElseIf g_step = CHECKING_INFO Then
g_step = ODBC_SETTING
ElseIf g_step = COMPLETE_PROCESS Then
g_step = CHECKING_INFO
End If

Call ShowTextMessage
End Sub

Private Sub Command4_Click()
Dim source As String
g_DSN = Text1.Text
g_UID = Text2.Text
g_PWD = Text3.Text

If Len(g_DSN) = 0 Then
MsgBox strReqDsnMsg, vbOKOnly, strTitle
Exit Sub
End If

source = "DSN=%1%;UID=%2%;PWD=%3%;"
source = Replace(source, "%1%", g_DSN)
source = Replace(source, "%2%", g_UID)
source = Replace(source, "%3%", g_PWD)

Load exceltoMysqltablosecfrm
If exceltoMysqltablosecfrm.LoadTableList(source) = True Then
exceltoMysqltablosecfrm.Show 1
Text4.Text = strSelectedTablename
End If
Unload exceltoMysqltablosecfrm
End Sub

Private Sub Form_Load()
g_step = XLS_SELECTION
Call ShowTextMessage

If Not Dir(App.Path & "\odbc_info.txt") = "" Then
Open App.Path & "\odbc_info.txt" For Input As #1
Input #1, g_DSN
Input #1, g_UID
Input #1, g_PWD
Input #1, g_Table
Close #1

Text1.Text = g_DSN
Text2.Text = g_UID
Text3.Text = g_PWD
Text4.Text = g_Table

End If
End Sub

Private Sub ShowTextMessage()
If g_step = XLS_SELECTION Then
txtMessage.Text = "İleri düğmesini tıklayın ve kaynak Excel dosyasını seçin. Not: Excel dosyasının ilk sayfası dikkate alınacaktır."
ElseIf g_step = ODBC_SETTING Then
txtMessage.Text = g_excelFilename & " seçildi. " & vbCrLf & " Þimdi ODBC bağlantı ayarlarını yapın. "
ElseIf g_step = CHECKING_INFO Then
txtMessage.Text = "Bilgilerin doğruluğunu kontrol edin." & vbCrLf & vbCrLf
txtMessage.Text = txtMessage.Text & "Excel : " & g_excelFilename & vbCrLf
txtMessage.Text = txtMessage.Text & "ODBC : Database adı / Kullanıcı adı / Þifre "
txtMessage.Text = txtMessage.Text & vbCrLf & vbCrLf
txtMessage.Text = txtMessage.Text & "İleri düğmesini tıklayın. "
txtMessage.Text = Replace(txtMessage.Text, "%1%", g_DSN)
txtMessage.Text = Replace(txtMessage.Text, "%2%", g_UID)
txtMessage.Text = Replace(txtMessage.Text, "%3%", g_PWD)
ElseIf g_step = COMPLETE_PROCESS Then
txtMessage.Text = "İşlem tamamlandı!"
End If

End Sub

Private Function GetColumnCount() As Long
Dim i As Long
Dim cols_count As Long
Dim xl_worksheet As Excel.Worksheet

Set xl_worksheet = xl.Worksheets(1)
For i = 1 To xl_worksheet.Columns.Count
If Not xl_worksheet.Cells(1, i) = "" Then
cols_count = cols_count + 1
End If
Next

GetColumnCount = cols_count
End Function

Private Function GetRowsCount() As Long
Dim i As Long
Dim cols_count As Long
Dim xl_worksheet As Excel.Worksheet

Set xl_worksheet = xl.Worksheets(1)

For i = 1 To xl_worksheet.Columns.Count
If Not xl_worksheet.Cells(1, i) = "" Then
cols_count = cols_count + 1
End If
Next

Dim j As Long
Dim rows_count As Long
Dim dummy As String
For i = 1 To xl_worksheet.Rows.Count
dummy = ""
For j = 1 To cols_count
dummy = dummy & xl_worksheet.Cells(i, j)
Next
If dummy = "" Then
Exit For
Else
rows_count = rows_count + 1
End If
Next

GetRowsCount = rows_count
End Function
'//////////Kod sonu////////////////