Opgelost Goede map openen.

[Dokman]

Hallo,

ik heb en script lopen, deze loopt goed. Alleen wil er graag en kleine aanpassing aan hebben. Maar ben al en tijdje aan het rommelen, maar kom er niet uit.

Het is en script die mijn en bestand laat importeren. Alleen nu opent die de map "C:\Users\xx\Documents" Maar wil graag dat die gelijk naar en andere map gaat. Waar kan ik dit veranderen? Bijvoorbeeld naar "C:\Users\xx\Desktop\Voorbeeld" want daar staat het bestand wat ik moet importeren.

De bestandsnaam is telkens anders dus kan hem ook niet zelf laten importeren. Of jullie moeten en idee hebben. Bestandsnaam is. "mms_csv_export_2024-12-03T06_52_19.792Z.csv" kan niet van de extensie uit gaan want er staan meer bestanden in met die extensie, het enige wat altijd hetzelfde is is "mms_csv_export_"

Sub ImportText()

ThisWorkbook.Sheets("PO in FMS630").Range("A1:L900").Delete xlUp

    Dim fileToOpen As Variant
    Dim fileFilterPattern As String
    Dim wsMaster As Worksheet
    Dim wbTextImport As Workbook
    Application.ScreenUpdating = False
    fileFilterPattern = "Text Files (*.txt; *.csv),*.txt;*.csv"
    fileToOpen = Application.GetOpenFilename(fileFilterPattern)
    If fileToOpen = False Then
        MsgBox "No file selected."
    Else
        Workbooks.OpenText _
            Filename:=fileToOpen, _
            StartRow:=1, _
            DataType:=xlDelimited, _
            Other:=True, _
        semicolon:=True
                Set wbTextImport = ActiveWorkbook
        Set wsMaster = ThisWorkbook.Worksheets("PO in FMS630")
        wbTextImport.Worksheets(1).Range("A1").CurrentRegion.Copy wsMaster.Range("A1")
        wbTextImport.Close False
 End If
    Application.ScreenUpdating = True
End Sub

Al vast bedankt voor jullie hulp.

 

[Warme bakkertje]

Probeer eens op deze manier.

ChDrive "C:"
ChDir "C:\Users\xx\Desktop\Voorbeeld"
fileToOpen = Application.GetOpenFilename(fileFilterPattern)

 

[Dokman]

@Warme bakkertje dankje werkt mooi.
Heb alleen de laatste regel niet gebruikt. Open die 2x de verkenner.

Dank voor je hulp

 

[Warme bakkertje]

Uiteraard, ik had die er maar bijgezet om aan te tonen hoe en waar de beide eerste regels te plaatsen.

Suc6 verder met je project.

 

[Dokman]

dankje.

 

[edmoor]

Doe het eens zo:

Dim f As Object
Set f = Application.FileDialog(msoFileDialogFilePicker)
With f
   .AllowMultiSelect = False
   .initialFilename = Environ("Userprofile") & "\Desktop\Voorbeeld\"
   .Filters.Clear
   .Filters.Add "Text Files", "*.txt; *.csv),*.txt;*.csv"
   If .Show Then MsgBox .SelectedItems(1)
End With

 

[Dokman]

Ik krijg dan 1x dat hij verkenner opent. Klik ik het bestand aan, daarna gaat hij nog en keer verkenner openen. Denk dat ik jouw code op de verkeerde plek plaats in het script.

 

[edmoor]

Hier opent hij de Verkenner slechts 1 keer.

 

[Dokman]

Denk dat ik hem dan ergens verkeert op de verkeerde plek in mijn bestaande script plakt.

 

[edmoor]

Het is niet alleen maar plakken.
Ik kan het niet testen, maar probeer deze eens:

Sub ImportText()
    ThisWorkbook.Sheets("PO in FMS630").Range("A1:L900").Delete xlUp
    Dim fd As Object
    Dim wsMaster As Worksheet
    Dim wbTextImport As Workbook
   
    Application.ScreenUpdating = False
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
       .AllowMultiSelect = False
       .InitialFileName = Environ("Userprofile") & "\Desktop\Voorbeeld\"
       .Filters.Clear
       .Filters.Add "Text Files", "*.txt; *.csv),*.txt;*.csv"
       If .Show Then
            Workbooks.OpenText _
                Filename:=.SelectedItems(1), _
                StartRow:=1, _
                DataType:=xlDelimited, _
                Other:=True, _
                semicolon:=True
            Set wbTextImport = ActiveWorkbook
            Set wsMaster = ThisWorkbook.Worksheets("PO in FMS630")
            wbTextImport.Worksheets(1).Range("A1").CurrentRegion.Copy wsMaster.Range("A1")
            wbTextImport.Close False
        End If
    End With
    Application.ScreenUpdating = True
End Sub

 

[Dokman]

Geprobeerd en werkt super. Ga er mee aan de slag.

Heb nog wel en ander probleem. Als ik programmacode weergeven druk gaat het venster open.
Maar op de enne of andere manier is dat en zooitje geworden. Alle vensters openen allemaal door elkaar heen. Van mijn mogen ze wel dicht blijven kan ze zelf wel openen die ik wil.

En Project - VBAProject staat ook en beetje raar.

 

[edmoor]

Dat staat los van de code.
Die vensters kan je gewoon sluiten.

 

[Dokman]

ja snap ik dat het er los van staat.
maar elke keer die rot vensters sluiten is ook niet.

 

[snb]

Als je het geïmporteerde bestand meteen verwijdert gaat deze code altijd goed:

Sub M_snb
   c00=Environ("Userprofile") & "\Desktop\Voorbeeld\"
   c00= c00 & dir(c00 & "*.csv")
   Sheets.Add , Sheets(Sheets.Count), , c00
   kill c00
end sub

 

[Dokman]

dank voor jullie meedenken en reactie. Heb het voor elkaar.

 

[AD1957]

Voor de vensters:
Klick rechtsboven in 1 van de vensters op "venster maximalisseren."