Bonjour à tous,


Dans le cadre de mon travail je cherche à automatiser l'extraction d'un progiciel sur ce fichier.
Etant relativement limitée en vba j'ai pu obtenir au sein de l'entreprise un code permettant de faire ce que je souhaite faire (selon moi), malheureusement lorsque je souhaite compiler la macro via un bouton permettant de faire l'import des données, une erreur 400 apparaît.

Je vous joins mon code en espérant que vous pourrez m'aider à y voir plus clair..


Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Private Sub Test_import()
 
    Dim SelectedFileName As String
 
    Dim NbLines As Long
 
    Dim TheName As Name
 
 
 
 
 
 
    'Create todays file
    ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & MOQ_FileNameBase & FactoryName & "_" & Format(Now, "yyyy-mm-dd") & ".xls", xlExcel10
 
    'Remove all named ranges
    For Each TheName In ThisWorkbook.Names
        TheName.Delete
    Next
 
    'Remove filter if activated
    If Sheet_Extract.AutoFilterMode = True Then
        Sheet_Extract.AutoFilterMode = False
    End If
 
    Sheet_Extract.Activate
    Sheet_Extract.Columns.Hidden = False
    Sheet_Extract.Columns("A:V").Delete Shift:=xlToLeft
    Sheet_Extract.Rows("1:65000").Delete Shift:=xlUp
    Sheet_Extract.Cells.Delete
 
 
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & SelectedFileName, _
        Destination:=Sheet_Extract.Range("A2"))
        .Name = "SKU_Projections_LF_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True 'false
        .TextFileCommaDelimiter = False 'true
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        '.TextFileDecimalSeparator = "."
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
 
    'Count the number of lines in the extract
    NbLines = Application.WorksheetFunction.CountA(Sheet_Extract.Columns(1))
 
 
    'Add autofilter
    Sheet_Extract.Range(Sheet_Extract.Cells(1, 1), Sheet_Extract.Cells(NbLines, LastColumn)).AutoFilter _
        Field:=Report_Col_ItemAlert, Criteria1:="=X"
 
    'End of rework of the file
    Application.ScreenUpdating = True
    'Disable the generate button
    Sheet_Menu.Test_import.Enabled = True
 
    'Display a message
    MsgBox "Import done.", vbOKOnly, "Done"
 
 
 
 
End Sub