1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117
| Sub Load_SF()
Application.ScreenUpdating = False
Dim fileToOpen As Variant, filePath As String, sqlString As String
Dim nbItem As Integer, LastLine As Integer
Dim LastRowSpec As Integer, LastColumnSpec As Integer
Dim y As Integer, i As Integer, z As Integer, langage As String, h As Integer, valuecol As Integer
Dim add As Boolean
Dim SettingLangline As Integer
SettingLangline = Sheets("SETTINGS").Range("R65536").End(xlUp).row
LastColumnSpec = ActiveSheet.UsedRange.Columns.Count
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
On Error GoTo ErrorHandler
MsgBox "Select SF file"
ChDrive "O"
ChDir Sheets("SETTINGS").Cells(3, 7)
'prompt with file selection
fileToOpen = Application.GetOpenFilename(, , 1, "Rechercher SF file...")
If fileToOpen = False Then
filePath = ""
Else
'get file path to open
filePath = CStr(fileToOpen)
End If
langage = Left(Right(filePath, 15), 11)
If Left(langage, 8) <> "CL6BN_SF" Then
MsgBox "You cannot open this file !"
End
End If
Set Cn = New ADODB.Connection
'new ADO connection to allow us to work on a closed Excel file
With Cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& filePath & ";Extended Properties=""Excel 12.0;HDR=YES;"""
.Open
End With
'if connection string is empty stop
If Cn = "" Then GoTo ErrorHandler
'Transaction to allow error prevention
Cn.BeginTrans
'begin transaction
sqlString = "SELECT * FROM [" & langage & "$]"
Set Rs = New ADODB.Recordset
Set Rs = Cn.Execute(sqlString)
' Range("A7:I" & LastRowSpec).Clear ' clear content
nbItem = Rs.Fields.Count ' The number of columns
y = 3
While Not Rs.EOF ' EOF of Data sheet ZQUA17
add = False
If Len(Rs(0)) = 7 And Left(Rs(0), 2) = 35 Then
Cells(y, 2) = Rs(0)
Cells(y, 1) = Rs(3)
Cells(y, 3) = Rs(7)
add = True
End If
Rs.MoveNext
For z = 0 To 3
If add = True And IsNull(Rs(0)) Then
For h = 1 To SettingLangline
If Sheets("SETTINGS").Cells(h, 18) <> "SF Master data" Then GoTo nexth
If Rs(6) = Sheets("SETTINGS").Cells(h, 21) Then
valuecol = RecupColValue(Sheets("SETTINGS").Cells(h, 20), 5)
Cells(y, valuecol) = Rs(7)
End If
nexth:
Next h
Rs.MoveNext
End If
Next z
y = y + 1
Wend
MsgBox "Load SF, done !"
'on success commit
Cn.CommitTrans
'close connection
Cn.Close
Set Cn = Nothing
End
ErrorHandler:
If filePath <> "" Then
'rollback on error
Cn.RollbackTrans
Cn.Close
Set Cn = Nothing
MsgBox "Une erreur est survenue" & _
vbNewLine & "(" & Err & " : " & Error(Err) & ")"
Else
MsgBox "Une erreur est survenue, vous n'avez pas sélectionné de fichier."
End If
End Sub |
Partager