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 |
