I am importing a batch of csv files from a folder all in separate worksheets, yet when I import the file, my new data loses leading zeroes for numbers and also loses its UTF-8 format. Is there any possible way to import the csv files while keeping leading zeroes and UTF-8 format?
Below is my vba
Option Explicit
Sub ImportCSVs()
Dim fPath As String
Dim fCSV As String
Dim wbCSV As Workbook
Dim wbMST As Workbook
Set wbMST = ThisWorkbook
fPath = "C:\mycsvfiles\Q3 2017\" 'path to CSV files, include the final \
Application.ScreenUpdating = False 'speed up macro
Application.DisplayAlerts = False 'no error messages, take default answers
fCSV = Dir(fPath & "*.csv") 'start the CSV file listing
On Error Resume Next
Do While Len(fCSV) > 0
Set wbCSV = Workbooks.Open(fPath & fCSV) 'open a CSV file
wbMST.Sheets(ActiveSheet.Name).Delete 'delete sheet if it exists
ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count) 'move new sheet into Mstr
Columns.AutoFit 'clean up display
fCSV = Dir 'ready next CSV
Loop
Application.ScreenUpdating = True
Set wbCSV = Nothing
End Sub
Thanks a million in advance! Let me know if I can provide additional information
Related
I am trying to rearrange the order of the columns in csv files in a folder on my local drive.
At the moment, from a tutorial, I have found a way to loop through the files. I wanted to cut a column and re insert in a different column. When running this code, Excel is crashing. It seems to be going through duplicate files.
I expected the columns to have moved in all the files in the folder. But they didn't move. And excel is crashing, looks like it's duplicating the files when hitting CTRL + G and running the code.
Here's the code.
Option Explicit
Sub FleetMoveColumns()
Dim fileDirectory As String
Dim fileCriteria As String
Dim fileName As String
Dim fileToOpen As Workbook
Application.ScreenUpdating = False
fileDirectory = "C:\...\*csv"
fileName = Dir(fileDirectory)
Do While Len(fileName) > 0
Set fileToOpen = Workbooks.Open(fileDirectory & fileName)
Columns("R").Cut
Columns("AB").Insert
Debug.Print fileName
Loop
Application.ScreenUpdating = True
End Sub
Please help.
You need to fully qualify your Columns object with a Worksheet object.
You need to place FileName = Dir within your Do While loop.
Modified code
Do While Len(FileName) > 0
Set fileToOpen = Workbooks.Open(fileDirectory & FileName)
' set the worksheet object
Set Sht = fileToOpen.Worksheets(1) ' <-- Rename "Sheet1" to your desired worksheet
With Sht
.Columns("R").Cut
.Columns("AB").Insert
End With
' clear objects
Set Sht = Nothing
Set fileToOpen = Nothing
Debug.Print FileName
FileName = Dir
Loop
I'm having an issue with the following code, that is supposed to sequentially open 〜100 csv files, check for a value in a cell (validation, if it is file with correct structure), copy single line of data and paste it into ThisWorkbook.Worksheets("2 CSV").Range("B" & row_number).
This solution worked for two years until this month. Now the whole Excel crashes randomly on any file without any error message. Sometimes it manages to loop through 20 files, sometimes 5.
The weirdest thing is, that I can loop manually using F8 through the whole thing without any problem.
The macro:
Sub b_load_csv()
Dim appStatus As Variant
Dim folder_path As String 'folder path to where CSVs are stored
Dim file_name As String 'file name of current CSV file
Dim row_number As Integer 'row number in target sheet
Dim source_sheet_name As String 'name of the source sheet of the CSV = CSV file name
Dim wb_src As Workbook 'variable for opened CSV source workbook
Dim sht_src As Worksheet 'variable for opened CSV source sheet
Dim sht_csv As Worksheet 'variable for target sheet in ThisWorkbook
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayAlerts = False
If .StatusBar = False Then appStatus = False Else appStatus = .StatusBar 'show currently processing file in status bar
End With
folder_path = "C:\Folder\SubFolder\" 'here are the files stored
file_name = Dir(folder_path & "*.csv") 'using dir to get file names
row_number = 3 'row number for pasting values
Set sht_csv = ThisWorkbook.Worksheets("2 CSV") 'target sheet for data aggregation
Do While file_name <> ""
Workbooks.Open (folder_path & file_name), UpdateLinks:=False, Local:=True 'open csv file
Set wb_src = Workbooks(file_name) 'assign opened csv file to variable
source_sheet_name = Left(file_name, InStr(file_name, ".") - 1) 'sheet name in csv is the same as the file name
Set sht_src = wb_src.Worksheets(source_sheet_name) 'assign source sheet to variable
If sht_src.Range("C1").Value2 = "OJ_POPIS" Then 'checks if the csv has the correct structure
sht_src.Range("A2:FZ2").Copy 'if so copies desired range
sht_csv.Range("B" & row_number).PasteSpecial 'and pastes it into target worksheet column B
End If
sht_csv.Range("A" & row_number).Value2 = file_name 'writes file name into column A
Application.CutCopyMode = False
wb_src.Close SaveChanges:=False
file_name = Dir() 'fetch next file name
row_number = row_number + 1
'the following lines is what I tried to fix the problem of random excel crashing
Set wb_src = Nothing
Set sht_src = Nothing
Application.StatusBar = "Processing file " & file_name
DoEvents
Application.Wait (Now + TimeValue("0:00:02"))
ThisWorkbook.Save 'save after every loaded file to see which files are causing the problem
Loop
MsgBox "Data from CSV files copied", vbOKOnly
Set sht_csv = Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Source CSV files are encoded both in UTF-8 and ANSI (my ACP is ANSI, 1250) and ; delimited.
Group policy restricting macros doesn't apply to me. I can sign my own macros.
What I tried:
Lines of code at the end of the loop
Identifying and deleting files triggering the crash (they have nothing in common, seemingly random, by the time a remove half of them... what is the point)
Simplifying the macro
New workbook
Different machine
VPN On/Off
Thank you for your help!
First thing I'd try is include a proper error handler (not resume next), particularly with x64, and ensure 'Break on all unhandled errors' is selected in Tools / Options / General.
Second thing I'd try is avoid using the clipboard -
With sht_src.Range("A2:FZ2")
sht_cvs.Range("B" & row_number).Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
(no need then to clear CutCopyMode)
Third thing I'd try is don't filter with Dir but something like this -
sFilter = "*.cvs"
file_name = Dir$(, 15) ' without vbDirectory if not getting subfolders
Do While Len(file_name)
If file_name Like sFilter Then
' process file
End If
file_name = Dir$(, 15)
Loop
Fourth thing I'd try is a good cup of coffee!
I reviewed several other questions discussing XLSM to CSV conversion while maintaining decimal format. The answers that I found were not using VBA and were more so saving the file manually. Code attached is meant to perform Copy range of values and paste as values and number format. These values are then formatted to 0.00. Whenever I convert my XLSM to CSV it will format the value to 0 instead of 0.00 . Other questions suggested saving the file as a text file and the correct wanted number format of 0.00 would appear. They did not when I tried. I have tried several times but have been unsuccessful such as pasting them as Values and Number format from another question that suggested it. How can I achieve this?
Sub FormatDecimal()
Sheet1.Range("C2:K100").NumberFormat = "0.00"
End Sub
Sub Main()
'User given warning message
Dim reply
reply = MsgBox("Do you want to proceed?", vbYesNo)
If reply = vbNo Then Exit Sub
CopyValues
WorksheetChange
DeleteRowIfCostCode
FormatDecimal
PrepareExport
CSV_Convert
End Sub
Sub CSV_Convert()
Dim FilePath As String
FilePath = ThisWorkbook.FullName
Dim Ext As String ' file extension
Dim Fn As String ' file name
Dim Path As String ' file path
Dim Ffn As String ' full file name
Dim Sp() As String
Dim CSVfile
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Foundation Budget Template")
' extracts number from 5th element and applies to file name
Sp = Split(FilePath, "\")
Fn = Sp(UBound(Sp))
Sp(7) = Split(Sp(4), "-")(0) & "import-TMP-IFI-REV12"
Ffn = Join(Sp, "\")
CSVfile = Ffn & ".CSV"
Application.ScreenUpdating = False
ws.Select
ws.Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=CSVfile, FileFormat:=xlCSV, local:=True
Application.DisplayAlerts = True
ActiveWorkbook.Close True
Application.ScreenUpdating = True
End Sub
Sub CopyValues()
Sheets("Foundation Budget Template").Range("A1:K100").Copy
Sheets("Foundation Budget Template").Range("A1:K100").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End Sub
I am very new to VBA. I was trying to save a tab from an excel worksheet into a separate csv file using VBA and below is the code I used. However, the code creates a csv file but the file size is significantly large. For example, even if the worksheet has just three rows, the csv file created would be of 21 MB. The reason being, my excel worksheet is filled with formulas for a 1000 rows and 20 columns. Also the number of entries will vary. Therefore after the execution, the csv would have empty rows(output attached as image)enter image description here. I just want to modify the code so that the empty rows(only the entire empty rows across 20 columns) are deleted from the csv. Any help is much appreciated.
Code:
Sub CREATE_CSV()
Sheet6.Unprotect Password:="1000"
Dim MyPath As String
Dim MyFileName As String
MyPath = Application.ActiveWorkbook.Path
MyFileName = "Titles_Footnotes"
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
Sheets("Titles_Footnotes").Copy
ActiveSheet.Range("1:4").EntireRow.Delete
ActiveSheet.Range("U:Z").EntireColumn.Delete
Application.DisplayAlerts = True
With ActiveWorkbook
Dim URvalues
Dim usedRangeAddress As String
usedRangeAddress = ActiveSheet.UsedRange.Address
URvalues = ActiveSheet.UsedRange
ActiveSheet.Cells.Delete
Range(usedRangeAddress) = URvalues
.SaveAs Filename:=MyPath & MyFileName, FileFormat:=xlCSV,CreateBackup:=False
.Close False
End With
Application.DisplayAlerts = True
Sheet6.Protect Password:="1000", AllowFiltering:=True
MsgBox ("CSV Created!")
End Sub
I need a function/Macro that allows me to import data from files with a specific file name.
More background:
I am downloading a large amount of excel files from an webpage containing Agricultural data for different countries (all files have the same structure in terms of rows and columns). This is done with an Python code that names the files according to a standard of: Country + Crop + Irrigation level + Management level. For instance: GhanaMaizeIrrigationLow.
I have created a excel with drop down menus to select each of these parameters and through the TEXTJOIN function merges it in accordance with the naming of the files.I now need some function/Macro that will import data from specific cells in the file that has the corresponding name. Is there a not too complicated way of doing this?
Thank you so much in advance!
Below is the code that I have used so far, however it imports all files in the folder and I want it only to import the files with a specific name.
Sub ImportCSVsWithReference()
Dim wbCSV As Workbook
Dim wsMstr As Worksheet: Set wsMstr = ThisWorkbook.Sheets("Sheet2")
Dim fPath As String: fPath = "C:\Users\nicol\Desktop\GIS\GAEZ_Downloads\CSV_Files\" 'path to CSV files, include the final \
Dim fCSV As String
If MsgBox("Clear the existing MasterCSV sheet before importing?", vbYesNo, "Clear?") _
= vbYes Then wsMstr.UsedRange.Clear
Application.ScreenUpdating = False 'speed up macro
fCSV = Dir(fPath & "*.csv") 'start the CSV file listing
Do While Len(fCSV) > 0
'open a CSV file
Set wbCSV = Workbooks.Open(fPath & fCSV)
'insert col A and add CSV name
Columns(1).Insert xlShiftToRight
Columns(1).SpecialCells(xlBlanks).Value = ActiveSheet.Name
'copy date into master sheet and close source file
ActiveSheet.UsedRange.Copy wsMstr.Range("A" & Rows.Count).End(xlUp).Offset(1)
wbCSV.Close False
'ready next CSV
fCSV = Dir
Loop
Application.ScreenUpdating = True
End Sub