I've got a folder which contains .txt files (they contain PHI, so I can't upload the .txt file, or an example without PHI, or even any images of it). I need an excel macro, which will allow the user to choose the folder containing the file, and will then insert the .txt file data into a new excel workbook, format the rows and columns appropriately, and finally save the file to the same folder that the source was found in.
So far I've got all of that working except for the formatting of rows and columns. As of now, the .txt data is inserted to a new workbook & worksheet, but I can't seem to figure out how to get rid of rows I don't need, or how to get the columns formatted appropriately.
Again, I can't upload the .txt file (or anything) because the Healthcare organization I work for blocks it - even if I've removed all PHI.
Below is the macro I've created so far:
Private Sub CommandButton2_Click()
On Error GoTo err
'Allow the user to choose the FOLDER where the TEXT file(s) are located
'The resulting EXCEL file will be saved in the same location
Dim FldrPath As String
Dim fldr As FileDialog
Dim fldrChosen As Integer
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder containing the Text File(s)"
.AllowMultiSelect = False
.InitialFileName = "\\FILELOCATION"
fldrChosen = .Show
If fldrChosen <> -1 Then
MsgBox "You Chose to Cancel"
Else
FldrPath = .SelectedItems(1)
End If
End With
If FldrPath <> "" Then
'Make a new workbook
Dim newWorkbook As Workbook
Set newWorkbook = Workbooks.Add
'Make worksheet1 of new workbook active
newWorkbook.Worksheets(1).Activate
'Completed files are saved in the chosen source file folder
Dim CurrentFile As String: CurrentFile = Dir(FldrPath & "\" & "*.txt")
Dim strLine() As String
Dim LineIndex As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
While CurrentFile <> vbNullString
'How many rows to place in Excel ABOVE the data we are inserting
LineIndex = 0
Close #1
Open FldrPath & "\" & CurrentFile For Input As #1
While Not EOF(1)
'Adds number of rows below the inserted row of data
LineIndex = LineIndex + 1
ReDim Preserve strLine(1 To LineIndex)
Line Input #1, strLine(LineIndex)
Wend
Close #1
With ActiveSheet.Range("A1").Resize(LineIndex, 1)
.Value = WorksheetFunction.Transpose(strLine)
.TextToColumns Other:=True, OtherChar:="|"
End With
ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveSheet.Name = Replace(CurrentFile, ".txt", "")
ActiveWorkbook.SaveAs FldrPath & "\" & Replace(CurrentFile, ".txt", ".xls"), xlNormal
ActiveWorkbook.Close
CurrentFile = Dir
Wend
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
Done:
Exit Sub
err:
MsgBox "The following ERROR Occurred:" & vbNewLine & err.Description
ActiveWorkbook.Close
End Sub
Any ideas of how I can delete entire lines from being brought into excel?
And how I can format the columns appropriately? So that I'm not getting 3 columns from the .txt file all jammed into 1 column in the resulting excel file?
Thanks
I'd recommend you not to re-invent the wheel. Microsoft provides an excellent add-on to accomplish this task, Power Query.
It lets you to load every file in a folder and process it in bulks.
Here you have a brief introduction of what can do for you.
Related
I'm attempting to put together some code in VBA where it will open a specific folder, let me choose the file then continue running my code.
Currently what I have (below) "works" in that it will open a folder but usually it starts from a generic location (Desktop) but will not go the the specific folder location to let me open the file I want.
Dim Filename as String
filename = Application.GetOpenFilename(FileFilter:="Excel Files, *.xl*;*.xm*")
If filename <> False Then
Workbooks.Open filename:=filename
End If
I've also tried something like this:
Dim Directory as String
Dim Filename as String
Directory = "\\page\data\NFInventory\groups\CID\Retail Setting\Lago Retail Uploads\" & strBrand & "\" & strSeason & "\" & strPrefix & "\"
Filename = Dir(Directory & "*.xl*;*.xm*")
Workbooks.Open Filename:=Directory
But it doesn't do anything and I think I have everything right. Any help or push in the right direction would be greatly appreciated.
-Deke
This will start an Open Dialog at the specified location:
Sub openBeckJFolder()
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Show
.InitialFileName = "C:\Users\beckj\"
End With
End Sub
The Microsoft document page doesn't really get into it, but FileDialog has several features such as the InitialFileName that I used here.
_
UPDATE: To open the workbook
Code added that allows you to highlight the workbook & click Open, or double-click on the workbook to open it.
Sub openBeckJFolder()
Dim Filename As String
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.InitialFileName = "C:\Users\beckj\"
If .Show = True Then
Filename = .SelectedItems(1)
End If
End With
Workbooks.Open (Filename)
End Sub
Can anyone help please with the following requirements?
Requirement A:
I'd like to create a loop to run a list of command strings in CMD as long as there's a non-zero value in column C. I think I need to define a variable i for my starting row as this will always be the same, and then run Shell(), pulling the command string from the corresponding cell in Row i, Column F. While Cells(i, "C") is not blank, keep going, increasing i by 1.
Requirement B:
I'd also like to link this macro to work in a directory deposited in a cell by an earlier macro that listed all the files in a selected directory.
This is what I have, without any looping..
Sub Run_Renaming()
Dim CommandString As Long
Dim i As Integer
i = 5
'Other steps:
'1 - need to pick up variable (directory of files listed, taken from first macro
'when doing manually, I opened command, went to correct directory, then pasted
'the commands. I'm trying to handle pasting the commands. I'm not sure if I need
'something to open CMD from VBA, then run through the below loop, or add opening
'CMD and going to the directory in each iteration of the below loop...
'2 - Need to say - Loop below text if Worksheets("Batch Rename of Files").Cells(i, "C").Value is no blank
CommandString = Worksheets("Batch Rename of Files").Cells(i, "F").Value
Call Shell("cmd.exe /S /K" & CommandString, vbNormalFocus)
'Other steps:
'3 - need to increase i by 1
'4 - need to check if C column is blank or not
'5 - need to end of C column is blank
End Sub
Background:
I'm creating a file renaming tool for a friend. They can use excel, but no programming languages or command prompt. Because of this, I don't want to have any steps, like creating a batch file suggested here, that would complicate things for my friend.
I've created an excel file with:
Tab 1 - a template sheet to create a new file name list. Works by concatenating several cells, adding a filetype, and outputting to a range of cells. Tab two links to this range when creating the renaming command strings for CMD
Tab 2 -
Button 1 - Sub rename() below. VBA to list files in a selected directory in Column C
Column F creates a command line that will rename File A as File B based on inputs to Tab 1 i.e. ren "File 1" "A1_B1_C1.xlsx"
Button 2 - Refers to a renaming macro (requirement 1 and 2 above) that picks up the selected directory from Button 1 and runs through all the renaming command strings while in that directory
Sub rename()
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "C:\"
Worksheets("Batch Rename of Files").Activate
Worksheets("Batch Rename of Files").Range("C4").Activate
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Loop
End If
End With
End Sub
Caveats:
1) I am not entirely clear on how you data etc is laid out so i am offering a way of achieving your goal that involves the elements i am clear on.
2) To be honest, personally, i would do as much using arrays or a dictionary as possible rather than going backwards and forwards to worksheets.
However...
Following the outline of your requirements and a little rough and ready, we have:
1) Using your macro rename (renamed as ListFiles and with a few minor tweaks) to write the chosen folder name out to Range("A1") in Worksheets("Batch Rename of Files") and the file names to Column C.
2) Using a second macro RenameFiles to pick up the rename shell commands from Column F of Worksheets("Batch Rename of Files"); write these out to a batch file on the desktop; add an additional first line command that sets the working directory to the chosen folder given in Range("A1") (Requirement A). The shell command executes the .bat file, completes the renaming (Requirement B) and then there is a line to remove the .bat file.
I am guessing this is a more efficient way of achieving your goal than looping the column F range executing a command one at a time.
I have not sought to optimize code in any further ways (i have added a few existing typed functions.) There are a number of other improvements that could be made but this was intended to help you achieve your requirements.
Let me know how it goes!
Tab1 layout (Sheet containing new file names):
Batch Rename of Files layout (Sheet containing output of the first macro and the buttons ):
Layout of Worksheet Batch Rename of File
In a standard module called ListFiles:
Option Explicit
Public Sub ListFilesInDirectory()
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$ 'type hints not really needed
Dim wb As Workbook
Dim wsTab2 As Worksheet
Set wb = ThisWorkbook
Set wsTab2 = wb.Worksheets("Batch Rename of Files")
InitialFoldr$ = "C:\"
Dim lastRow As Long
lastRow = wsTab2.Cells(wsTab2.Rows.Count, "C").End(xlUp).Row
wsTab2.Range("C4:C" & lastRow).ClearContents 'Get rid of any existing file names
wsTab2.Range("C4").Activate
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)
wsTab2.Range("A1") = xDirect$
Do While xFname$ <> vbNullString
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Loop
End If
End With
End Sub
In a standard module called FileRenaming:
Option Explicit
Sub RenameFiles()
Dim fso As New FileSystemObject
Dim stream As TextStream
Dim strFile As String
Dim strPath As String
Dim strData As Range
Dim wb As Workbook
Dim wsTab2 As Worksheet
Dim currRow As Range
Set wb = ThisWorkbook
Set wsTab2 = wb.Worksheets("Batch Rename of Files")
strPath = wsTab2.Range("A1").Value2
If strPath = vbNullString Then
MsgBox "Please ensure that Worksheet Batch Rename of Files has a directory path in cell A1"
Else
If Right$(Trim$(strPath), 1) <> "\" Then strPath = strPath & "\"
strFile = "Rename.bat"
Dim testString As String
Dim deskTopPath As String
deskTopPath = Environ$("USERPROFILE") & "\Desktop" 'get desktop path as this is where .bat file will temporarily be saved
testString = fso.BuildPath(deskTopPath, strFile) 'Check if .bat already exists and delete
If Len(Dir(testString)) <> 0 Then
SetAttr testString, vbNormal
Kill testString
End If
Set stream = fso.CreateTextFile(deskTopPath & "\" & strFile, True) 'create the .bat file
Dim lastRow As Long
lastRow = wsTab2.Cells(wsTab2.Rows.Count, "C").End(xlUp).Row
Set strData = wsTab2.Range("F4:F" & lastRow) 'Only execute for as many new file names as present in Col C (in place of your until blank requirement)
stream.Write "CD /D " & strPath & vbCrLf
For Each currRow In strData.Rows 'populate the .dat file
stream.Write currRow.Value & vbCrLf
Next currRow
stream.Close
Call Shell(testString, vbNormalFocus)
Application.Wait (Now + TimeValue("0:00:01")) 'As sometime re-naming doesn't seem to happen without a pause before removing .bat file
Kill testString
MsgBox ("Renaming Complete")
End If
End Sub
Buttons code in Worksheet Batch Rename of Files
Private Sub CommandButton1_Click()
ListFilesInDirectory
End Sub
Private Sub CommandButton2_Click()
RenameFiles
End Sub
Example .bat file contents:
VERSION 2
And here is a different version using a dictionary and passing parameters from one sub to another. This would therefore be a macro associated with only one button push operation i.e. there wouldn't be a second button. The single button would call ListFiles which in turn calls the second macro. May require you to go in to tools > references and add in Microsoft Scripting Runtime reference.
Assumes you have a matching number of new file names in Col D of tab 1 as the number of files found in the folder (as per your script to obtain files in folder). I have removed the obsolete type references.Shout out to the RubberDuck VBA add-in crew for the add-in picking these up.
In one standard module:
Option Explicit
Public Sub ListFiles()
Dim xDirect As String, xFname As String, InitialFoldr As String
Dim wb As Workbook
Dim ws As Worksheet
Dim dict As New Scripting.Dictionary
Dim counter As Long
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Tab1") 'Worksheet where new file names are
counter = 4 'row where new file names start
InitialFoldr = "C:\"
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr
.Show
If .SelectedItems.Count <> 0 Then
xDirect = .SelectedItems(1) & "\"
xFname = Dir(xDirect, 7)
Do While xFname <> vbNullString
If Not dict.Exists(xFname) Then
dict.Add xFname, ws.Cells(counter, "D") 'Or which ever column holds new file names. This add to the dictionary the current name and new name
counter = counter + 1
xFname = Dir
End If
Loop
End If
End With
RenameFiles xDirect, dict 'pass directory path and dictionary to renaming sub
End Sub
In another standard module:
Public Sub RenameFiles(ByVal folderpath As String, ByRef dict As Dictionary)
Dim fso As New FileSystemObject
Dim stream As TextStream
Dim strFile As String
Dim testString As String
Dim deskTopPath As String
strFile = "Rename.bat"
deskTopPath = Environ$("USERPROFILE") & "\Desktop"
testString = fso.BuildPath(deskTopPath, strFile)
'See if .dat file of same name already on desktop and delete (you could overwrite!)
If Len(Dir(testString)) <> 0 Then
SetAttr testString, vbNormal
Kill testString
End If
Set stream = fso.CreateTextFile(testString, True)
stream.Write "CD /D " & folderpath & vbCrLf
Dim key As Variant
For Each key In dict.Keys
stream.Write "Rename " & folderpath & key & " " & dict(key) & vbCrLf 'write out the command instructions to the .dat file
Next key
stream.Close
Call Shell(testString, vbNormalFocus)
Application.Wait (Now + TimeValue("0:00:01")) 'As sometime re-naming doesn't seem to happen without a pause before removing .bat file
Kill testString
' MsgBox ("Renaming Complete")
End Sub
Scripting run time reference:
Adding runtime reference
Additional method for finding the desktop path. Taken from Allen Wyatt:
In a standard module add the following:
Public Function GetDesktop() As String
Dim oWSHShell As Object
Set oWSHShell = CreateObject("WScript.Shell")
GetDesktop = oWSHShell.SpecialFolders("Desktop")
Set oWSHShell = Nothing
End Function
Then in the rest of the code replace any instances of deskTopPath =..... e.g.:
deskTopPath = Environ$("USERPROFILE") & "\Desktop"
With
desktopPath = GetDesktop
I am looking to convert the code below to one where user is not required to select the files .
This code is to select a specific sheet from all the workbooks in the specific folder say" C:\Test"
This is a part of a consolidation macro
sub open_issues_sheet()
Dim Files as Variant
Files = Application.GetopenFilename("Excel FIles (*xl*),*xl*",Title:="Select Files", Multiselect:=True)
For Z = LBound(Files) To UBound(Files)
tem=Split(Files(Z),"\")
If(tem(UBound(tem)) <> ThisWorbook.Name) Then
Set S= Workbooks.Open(Files(Z))
S.Sheets("Issues").Select
'code to copy to current sheet
I tried using this http://spreadsheetpage.com/index.php/tip/getting_a_list_of_file_names_using_vba/
but I was getting a "Type Mismatch" Error at the Line "For Z =LBound"
Assuming that you still need the user to pick the folder containing the files that need to be consolidated, using the FileDialog(msoFileDialogFolderPicker) would be acceptable solution.
Dim sFilePath As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Title = "Select folder to consolidate"
If .Show = -1 Then
'Get the first file listed in the folder
sFilePath = Dir(.SelectedItems(1) & "\")
Do While Not sFilePath Like vbNullString
'Verify the extension before opening file
If Mid$(sFilePath, InStrRev(sFilePath, ".")) Like ".xls" Then
' Perform task ...
End If
'Get next file
sFilePath = Dir
Loop
End If
End With
Ok so I am trying to quickly open a file path using 2 cell values, everything works fine if I know the information verbatim. My issue is on the last value I will only have the first part of the file name, I have tried using the wildcard * but can't seem to get it to work. Keep getting "Path not found error". The second value is a project name, however, the folders also contain a description of the project. For example I know the project name is TB1756_2156 but the folder is named "TB1756_2156 Project Description Person in Charge January 2014" this is the code I have so far:
Sub Button2_Click()
ChDrive "S:\"
ChDir "S:\CLIENTS " & Range("B10").Value & "\Client1\" & Range("B11").Value & "*\Sample"
strFile = Application.GetOpenFilename
End Sub
EDIT:
Ok so if I where to manually open the file I want to examine this would be my path: S:\CLIENTS YEAR\FOLDER NAME\Project # Description Project Lead Year\Sample\File I want.xls
The vba I want open the dialog box and goes to the S:\CLIENTS then adds value from cell B10 then continues to FOLDER NAME\ then grabs just the Project # from cell B11 as this is all you would have handy , then would fill in the missing information, then continue to \Sample where the user would then select the file they want to open.
So manipulating the code provide by #dcromley this is what I got:
Sub UseFileDialogOpen()
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.InitialFileName = "S:\CLIENTS " & Range("C10").Value & "\FOLDER NAME\ & Range("C11").Value
.Show
End With
End Sub
My issue with this is that it only enters the Project # into the File Name: but does not actually open it. So looking for a way to parse the directory as I have it already from my original code minus the "*\Sample" and that it would open the only folder that starts with the Project #
If you have the first part of the file name and want the filename, this will do it.
If you want a directoryname, change vbNormal to vbDirectory.
Sub Main()
MsgBox FindFilename("abc", "Z:\untitled\")
End Sub
Function FindFilename$(FirstPart$, DirWhere$)
Dim sw1&, Filename$
Do
If sw1 = 0 Then
sw1 = 1
Filename = Dir$(DirWhere, vbNormal)
Else
Filename = Dir$()
End If
If Filename = "" Then Exit Do
If FirstPart = Left$(Filename, Len(FirstPart)) Then
FindFilename = Filename
Exit Function
End If
Loop
MsgBox "Error - Filename not found"
End Function
EDIT:
From the Excel 2003 help (you have the complete (initial) dirname now, right?):
Sub UseFileDialogOpen()
Dim lngCount&
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.InitialFileName = "Z:\untitled\"
.Show
For lngCount = 1 To .SelectedItems.Count
MsgBox .SelectedItems(lngCount)
Next lngCount
End With
End Sub
EDIT2: To open a *.xls file:
Sub Openxls()
Dim filename$
filename = "z:\untitled\dave1.xls"
Workbooks.Open filename
End Sub
I think dcromley's approach is sound but let us simplify things a little bit.
Dim prjDir As String, prjName As String
Dim initialFile As String, myDirString As String
'~~> B11 contains part of the foldername
'~~> B10 value as is
prjDir = "C:\CLIENTS\" & Range("B10") & "\Client1\" & Range("B11") & "*"
prjDir = Dir(prjDir, vbDirectory) '~~> use Dir to get the actual folder name
prjName = "C:\CLIENTS\" & Range("B10") & "\Client1\" & prjDir & "\*SAMPLE*.xls"
prjName = Dir(prjName, vbNormal) 'use Dir to get the actual filename
initialFile = "C:\CLIENTS\" & Range("B10") & "\Client1\" & prjDir & "\" & prjName
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Add "Excel Files", "*.xls"
.FilterIndex = 1
.InitialFileName = initialFile
.AllowMultiSelect = False
If .Show = False Then MsgBox "Please select Excel file.", vbExclamation: Exit Sub
myDirString = .SelectedItems(1)
.Filters.Clear
End With
Workbooks.Open myDirString '~~> Open the file
Is this close to what you want to achieve?
Btw, I assumed your Project # is unique.
I am a total dummy as for vb and excel, have tried to combine 2 macros that I have found around here, into 1, but obviously did something terribly wrong and now i'm stuck.. First I just used this macro (saved it in as personal.xlsb so as to be able to use it in any workbook)
Sub CSVFile()
Dim SrcRg As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim FName As Variant
FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")
ListSep = ";"
If Selection.Cells.Count > 1 Then
Set SrcRg = Selection
Else
Set SrcRg = ActiveSheet.UsedRange
End If
Open FName For Output As #1
For Each CurrRow In SrcRg.Rows
CurrTextStr = ìî
For Each CurrCell In CurrRow.Cells
CurrTextStr = CurrTextStr & """" & GetUTF8String(CurrCell.Value) & """" & ListSep
Next
While Right(CurrTextStr, 1) = ListSep
CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
Wend
Print #1, CurrTextStr
Next
Close #1
End Sub
That plus the GetUTF8String function code. Now that was working fine. Then I have thought well why not just experiment with my limited (that is a serious understatement) vb understanding, added the following code and changed the CSVFile sub into a function, which I then called from the sub below, with the output file name as a parameter (to be used instead FName = Application.GetSaveAsFilename). I thought yeah, this code saves all sheets automatically, now let's just make sure that the encoding and delimiter/enclosure setting function runs before each sheet is saved. It doesn't seem right but I thought hey why not try..
Public Sub SaveAllSheetsAsCSV()
On Error GoTo Heaven
' each sheet reference
Dim Sheet As Worksheet
' path to output to
Dim OutputPath As String
' name of each csv
Dim OutputFile As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
' Save the file in current director
OutputPath = ThisWorkbook.Path
If OutputPath <> "" Then
Application.Calculation = xlCalculationManual
' save for each sheet
For Each Sheet In Sheets
OutputFile = OutputPath & Application.PathSeparator & Sheet.Name & ".csv"
' make a copy to create a new book with this sheet
' otherwise you will always only get the first sheet
Sheet.Copy
' this copy will now become active
CSVFile(OutputFile)
ActiveWorkbook.SaveAs Filename:=OutputFile, FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
Next
Application.Calculation = xlCalculationAutomatic
End If
Finally:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Exit Sub
Heaven:
MsgBox "Couldn't save all sheets to CSV." & vbCrLf & _
"Source: " & Err.Source & " " & vbCrLf & _
"Number: " & Err.Number & " " & vbCrLf & _
"Description: " & Err.Description & " " & vbCrLf
GoTo Finally
End Sub
Saved that and with that I have managed to achieve something very different. On opening any workbooks, that macro runs and opens up my sheets from that particular workbook as csv files (without saving them). Now I am like Alice in Wonderland. How come it is running on file open? That is not desirable, so I went back to the macro code and changed it back to just the csvfile sub. Well that didn't help, no idea what I did there, was definitely editing the same macro... So I deleted the macro, the modul, I cannot imagine where the thing now is but it's still running + I get this warning that macros were deactivated. Can't get rid of it! Now lads, I'm sorry for the total lack of professionality from my side, this was just supposed to be a small favor for a client, without wasting loads of time learning vb, coz my boss doesn't like that... I am of course interested in how to achieve the goal of saving the sheets automatically after setting the deimiter and enclosure in them. And at this moment I am very interested in how to get rid of that macro and where it is hiding.. What have I done?! Thank you for your patience!
I think the problem lies with the line
OutputPath = ThisWorkbook.Path
Because you are running this from your personal.xlsb which is stored in your XLSTART folder it has created the CSV files in the same location. When Excel starts it will try and load any files that it finds in that location.
Just locate your XLSTART folder and delete any CSV files you find there.
Try using
OutputPath = ActiveWorkbook.Path
XLSTART folder location, dependent on your system, is probably something like:
C:\Users\YOURNAME\AppData\Roaming\Microsoft\Excel\XLSTART