lixfelix123
New Member
- Joined
- Jun 30, 2020
- Messages
- 2
- Office Version
- 2016
- Platform
- Windows
I'm trying to upload some excel file into sql server this is my second file to upload,i'm using same code for first file and its working but not for this file
this is my code for first file
===============AND This code not working==============
this is my code for first file
VBA Code:
Dim filetoopen As Variant
Dim opeenbook As Workbook
filetoopen = Application.GetOpenFilename(Title:="Browse For Your File", FileFilter:="Excel Files(*.xlsx),*xls*")
If filetoopen <> False Then
Application.ScreenUpdating = False
Set opeenbook = Application.Workbooks.Open(filetoopen)
End If
Dim conn As ADODB.Connection
Dim cs As String
Dim sqlcmd As String
Set conn = New ADODB.Connection
cs = "DRIVER=SQL SERVER;"
cs = cs & "SERVER=FELIX"
conn.Open cs, "", ""
sqlcmd = "CREATE DATABASE MAGANG"
conn.Execute sqlcmd
conn.Close
Set conn = New ADODB.Connection
cs = "DRIVER=SQL SERVER;"
cs = cs & "DATABASE=MAGANG;"
cs = cs & "SERVER=FELIX"
conn.Open cs, "", ""
sqlcmd = "CREATE TABLE Detail_Data(ID Varchar(255) PRIMARY KEY, MODE Varchar(255),ORIGIN Varchar(255),HWBL Varchar(255),[CONTAINER 20] INT,[CONTAINER 40] INT,VOLUME VARCHAR(255),[GROSS WEIGHT] Varchar(255),[CHARGEABLE WEIGHT] Varchar(255));"
conn.Execute sqlcmd
conn.Close
Set conn = Nothing
Workbooks("Detail_Data").Sheets("3-Detail_Data").Cells.Select
With Workbooks("Detail_Data").Worksheets("3-Detail_Data").Sort
.SetRange Range("A:I")
.Header = xlYes
.Orientation = xlTopToBottom
.Apply
End With
lr = Workbooks("Detail_Data").Worksheets("3-Detail_Data").Cells(Rows.Count, 1).End(xlUp).Row
For i = lr To 2 Step by - 1
If Worksheets("3-Detail_Data").Cells(i, 1).Value = Worksheets("3-Detail_Data").Cells(i - 1, 1).Value Then
Worksheets("3-Detail_Data").Rows(i).Select
Selection.Delete shift:=xlUp
End If
Next
Dim l_row As Long
Dim s_MODE As String
Dim s_ORIGIN As String
Dim s_ID As String
Dim s_HWBL As String
Dim s_CONTAINER20 As Integer
Dim s_CONTAINER40 As Integer
Dim s_VOLUME As String
Dim s_GROSSWEIGHT As String
Dim s_CHARGEABLEWEIGHT As String
Set conn = New ADODB.Connection
cs = "DRIVER=SQL SERVER;"
cs = cs & "DATABASE=MAGANG;"
cs = cs & "SERVER=FELIX"
With Workbooks("Detail_Data").Sheets("3-Detail_Data")
conn.Open cs, "", ""
l_row = last_row_with_data(1, ActiveSheet)
For i = 2 To l_row
s_ID = .Cells(i, 1)
s_MODE = .Cells(i, 2)
s_ORIGIN = .Cells(i, 3)
s_HWBL = .Cells(i, 4)
s_CONTAINER20 = .Cells(i, 5)
s_CONTAINER40 = .Cells(i, 6)
s_VOLUME = .Cells(i, 7)
s_GROSSWEIGHT = .Cells(i, 8)
s_CHARGEABLEWEIGHT = .Cells(i, 9)
sqlcmd = "insert into dbo.Detail_Data (ID, MODE, ORIGIN,HWBL,[CONTAINER 20],[CONTAINER 40],VOLUME,[GROSS WEIGHT],[CHARGEABLE WEIGHT]) values ('" & s_ID & "', '" & s_MODE & "', '" & s_ORIGIN & "','" & s_HWBL & "','" & s_CONTAINER20 & "','" & s_CONTAINER40 & "','" & s_VOLUME & "','" & s_GROSSWEIGHT & "','" & s_CHARGEABLEWEIGHT & "')"
conn.Execute sqlcmd
Next
conn.Close
Set conn = Nothing
End With
Workbooks("Detail_Data").Close savechanges:=False
End Sub
===============AND This code not working==============
Rich (BB code):
Private Sub MasterData_Click()
Dim filetoopen2 As Variant
Dim opeenbook2 As Workbook
filetoopen2 = Application.GetOpenFilename(Title:="Browse For Your File", FileFilter:="Excel Files(*.xlsx),*xls*")
If filetoopen2 <> False Then
Application.ScreenUpdating = False
Set opeenbook2 = Application.Workbooks.Open(filetoopen2)
End If
Dim conn As ADODB.Connection
Dim cs As String
Dim sqlcmd As String
Set conn = New ADODB.Connection
cs = "DRIVER=SQL SERVER;"
cs = cs & "SERVER=FELIX"
conn.Open cs, "", ""
On Error GoTo errr
sqlcmd = "CREATE DATABASE MAGANG"
conn.Execute sqlcmd
conn.Close
errr:
Set conn = New ADODB.Connection
cs = "DRIVER=SQL SERVER;"
cs = cs & "DATABASE=MAGANG;"
cs = cs & "SERVER=FELIX"
conn.Open cs, "", ""
sqlcmd = "CREATE TABLE Master_Data(HWBL varchar(255),ID Varchar(255) PRIMARY KEY, MWBL Varchar(255));"
On Error GoTo errormastertable
conn.Execute sqlcmd
conn.Close
Set conn = Nothing
errormastertable:
Workbooks("MasterData").Sheets("1-Master_Data").Cells.Select <<<OUT OF RANGE
With Workbooks("MasterData").Worksheets("1-Master_Data").Sort
.SetRange Range("A:C")
.Header = xlYes
.Orientation = xlTopToBottom
.Apply
End With
lr = Workbooks("MasterData").Sheets("1-Master_Data").Cells(Rows.Count, 3).End(xlUp).Row
For i = lr To 2 Step by - 1
If Worksheets("1-Master_Data").Cells(i, 1).Value = Worksheets("1-Master_Data").Cells(i - 1, 1).Value Then
Worksheets("1-Master_Data").Rows(i).Select
Selection.Delete shift:=xlUp
End If
Next
'=====================================================================
'=====================================================================
'=====================================================================
Dim l_row As Long
Dim s_ID As String
Dim s_HWBL As String
Dim s_MWBL As String
Set conn = New ADODB.Connection
cs = "DRIVER=SQL SERVER;"
cs = cs & "DATABASE=MAGANG;"
cs = cs & "SERVER=FELIX"
With Workbooks("MasterData").Sheets("1-Master_Data")
conn.Open cs, "", ""
l_row = last_row_with_data(1, ActiveSheet)
For i = 2 To l_row
s_HWBL = .Cells(i, 1)
s_MWBL = .Cells(i, 2)
s_ID = .Cells(i, 3)
sqlcmd = "insert into dbo.Master_Data (HWBL, MWBL,ID) values ('" & s_HWBL & "', '" & s_MWBL & "', '" & s_ID & "')"
conn.Execute sqlcmd
Next
conn.Close
Set conn = Nothing
End With
Workbooks("MasterData").Close savechanges:=False
End Sub
Public Function last_row_with_data(ByVal lng_column_number As Long, shCurrent As Variant) As Long
last_row_with_data = shCurrent.Cells(Rows.Count, lng_column_number).End(xlUp).Row
End Function
Last edited by a moderator: