• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Bestanden niet dubbel importeren

Status
Niet open voor verdere reacties.

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:
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
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan