BasSchuring
Gebruiker
- Lid geworden
- 28 okt 2013
- Berichten
- 32
Beste mensen,
Ik heb ooit de volgende code gekregen van hsv. Deze heb ik later opgedeeld in 2 delen om het iets overzichtelijker te maken.
Maar nu zou ik hier graag nog iets aan toevoegen. Ik plaats nu .csv bestanden in een map, start de macro en verplaatst daarna de bestanden in een andere map zodat ze niet dubbel geimporteerd worden. Die laatste stap zou ik graag overslaan.
Dit is de code voor het importeren van de bestanden:
En dit is het truckje wat er met de bestanden moet gebeuren;
De CSV bestanden hebben de naam van de ordernummers die eventueel gecheckt kunnen worden in in tabblad filter kolom A deze nummer staan hier dan wel dubbel in vermeld.
Iemand een handig stukje wat ik er tussen kan voegen zodat bestanden niet 2 keer geimporteerd worden in verschillende runs??
Alvast bedankt!
Groeten
Bas
Ik heb ooit de volgende code gekregen van hsv. Deze heb ik later opgedeeld in 2 delen om het iets overzichtelijker te maken.
Maar nu zou ik hier graag nog iets aan toevoegen. Ik plaats nu .csv bestanden in een map, start de macro en verplaatst daarna de bestanden in een andere map zodat ze niet dubbel geimporteerd worden. Die laatste stap zou ik graag overslaan.
Dit is de code voor het importeren van de bestanden:
Code:
Sub hsv2()
Dim wbCSV As Workbook
Dim wsMstr As Worksheet: Set wsMstr = ThisWorkbook.Sheets("Export shop")
Dim fPath As String: fPath = "Z:\WEBSHOP\Admin\shop csv\"
Dim fCSV As String
Dim c As Range, firstaddress As String, j As Long, n As Long
'If MsgBox("'Leeg Sheet Export shop voor inlezen CSV?", vbYesNo, "Clear?") _
= vbYes Then wsMstr.UsedRange.Clear
Application.ScreenUpdating = False
fCSV = Dir(fPath & "*.csv")
Do While Len(fCSV) > 0
Set wbCSV = Workbooks.Open(fPath & fCSV)
ActiveSheet.UsedRange.Copy wsMstr.Range("A1")
wbCSV.Close False
With Sheets("export shop")
Call hsv
End With
fCSV = Dir
Loop
Application.ScreenUpdating = True
Sheets("Filter").Select
Cells.Select
Selection.AutoFilter
Selection.AutoFilter
Sheets("export shop").UsedRange.Clear
Call sort2
End Sub
En dit is het truckje wat er met de bestanden moet gebeuren;
Code:
Sub hsv()
Dim c As Range, firstaddress As String, j As Long, n As Long
With Sheets("export shop")
With .Range("a1:a" & .Cells(Rows.Count, 1).End(xlUp).Row)
ReDim arr(.Rows.Count, 9)
Set c = .Find("product", , , xlPart)
If Not c Is Nothing Then
firstaddress = c.Address
Do
If UCase(Split(c)(0)) = "PRODUCT" Then
For j = 0 To 8
arr(n, j) = c.Offset(j)
Next j
n = n + 1
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With
End With
With Sheets("gesorteerd")
.Cells(1).CurrentRegion.ClearContents
.Cells(1).Resize(n, 9) = arr
.Columns(1).Resize(, 9).AutoFit
End With
Sheets("Filter").Select
Selection.AutoFilter
Application.ScreenUpdating = True
Application.EnableEvents = False
With Sheets("Filter")
Sheets("orderoverzicht").Cells(1).CurrentRegion.Offset(1).Copy
.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
With .Cells(1).CurrentRegion
.Value = .Value
'.Offset(1).Sort .Range("D1")
.Columns(1).NumberFormat = "general"
.Columns(6).NumberFormat = "dd-mm-yyyy"
Application.Goto .Cells(1)
Sheets("Filter").Select
Cells.Select
Selection.AutoFilter
End With
Call select_pakbon
End With
End Sub
De CSV bestanden hebben de naam van de ordernummers die eventueel gecheckt kunnen worden in in tabblad filter kolom A deze nummer staan hier dan wel dubbel in vermeld.
Iemand een handig stukje wat ik er tussen kan voegen zodat bestanden niet 2 keer geimporteerd worden in verschillende runs??
Alvast bedankt!
Groeten
Bas