(Solved) – VBA OUT OF RANGE BROWSE FILE AND UPLOAD TO SQLSERVER

(solved)-–-vba-out-of-range-browse-file-and-upload-to-sqlserver

My Code stop in this line “Out Of Range”

With Workbooks("MasterData").Worksheets("1-Master_Data").Sort
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
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

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

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

Leave a Reply

Your email address will not be published. Required fields are marked *