VBA Code to Convert CSV to XLS - excel

Objective: I have a folder where multiple CSVs are dumped on my drive. These CSVs need to be converted to XLS files and saved (as XLS files) into the same, original folder. I have a code (pasted below) for it that works just fine, but...
Problem: A window pops up each time saying "Code execution has been interrupted," allowing me to Continue, End, or Debug. I can click Continue each time the window pops up (it pops up for each file that needs to be converted) and the script will work perfectly, but of course, I'd rather not have to click Continue potentially hundreds of times. The asterisk'd part of the code below is the part that is highlighted upon clicking Debug.
Sub Convert_CSV_XLS()
Dim wb As Workbook
Dim strFile As String, strDir As String
strDir = "xx:\xx\xx\xx\xx\xx\xx\xx\"
strFile = Dir(strDir & "*.csv")
Do While strFile <> ""
Set wb = Workbooks.Open(Filename:=strDir & "\" & strFile, Local:=True)
**wb.SaveAs Replace(wb.FullName, ".csv", ".xls"), 56**
wb.Close SaveChanges:=False
Set wb = Nothing
strFile = Dir
Loop
End Sub
Again - the code DOES work, it's just that the Debug window keeps popping up and I can't figure out what the issue is. By the way, I had to "xx" out the actual directory.
Thank you for any help!

Try : this
It may help solving your problem, I had one of those sticky debug boxes too for no reason at all and this line helped me.
Edit: Here's the code from the website above which solves the problem described.
Adding this line in the beggining of one's code will do the trick.
Application.EnableCancelKey = xlDisabled

Related

Excel VBA won't save: creating 8-digit alphanumeric "filename"

I am new to VBA. I am using a "shell" macro to run another macro on a series of files. It won't save. I am going to include my code here and also a series of photos because the photos were the only way to show the result of hovering over the values in the code.
So, the error message is generating something I don't understand. But it is clear that the links in the code link to what the results should be, so I'm confused.
This is the code:
Sub SHELLforMacros()
Dim wbMatrix As Workbook
Dim strFileName As String
Dim strFileName As String
Dim newFileName As String
Dim strPath As String
Dim strExt As String
Dim objWorkbook As Workbook
Dim ws As Worksheet
Dim Sheetname As Worksheet
Set Sheetname = Worksheets(1)
Dim Worksheet As Worksheet
Dim rng As Range
Set rng = Range("A2")
strPath = "C:\Users\myname\Desktop\All_mricgcm3_files\45\Fall45\test\"
strExt = "csv"
strFileName = Dir(strPath & "*." & strExt)
While strFileName <> ""
Set wbMatrix = Workbooks.Open(strPath & strFileName)
Application.Run "'C:\Users\myname\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB'!Graph_NEW"
strPath = "C:\Users\myname\All_mricgcm3_files\45\Fall45\test\"
newFileName = Sheetname.Range("A2").Value
ActiveWorkbook.SaveAs fileName:=strPath & newFileName, FileFormat:=51
ActiveWorkbook.Close SaveChanges:=True
Wend
End Sub
What this macro is supposed to do is open a file, run another macro on the file (creating a graph), and then save the file with the same name but as an .xlsx file. Then open the next file in the folder and do the same, until it runs out of files. I realize the code may not be the most current. It is cobbled together from things I've found online. Thanks for any help.
Edit: UPDATE - I removed all the section on saving and closing the file from the "shell" macro and put it into the "Graph_NEW" macro. Now the "shell" macro is running fine. But I am running into the same issue with the "Graph_NEW" macro now. It is exactly the same error message as highlighted in the first image, only each time there is a new 8-digit alphanumeric "filename" that it is looking for. This seems like a very specific thing.
I changed the section in the following ways, successively, in an attempt to debug. I added With and End With around the section:
With WB
ActiveWorkbook.Save
newFileName = Sheetname.Range("A2").Value
strPath = "C:\Users\qmontana\All_mricgcm3_files\mric45\Fall45\test\"
ActiveWorkbook.SaveAs fileName:=strPath & newFileName & ".xlsx", FileFormat:=51
ActiveWorkbook.Close SaveChanges:=True
End With
I changed the name of the folder from "45" to "mric45" thinking that maybe it didn't like a number as a folder name.
I removed the "backslash" at the end of the strPath--and then the 8-digit alphanumeric string showed up as an error after the Fall45 folder, like this "C:\Users\myname\Desktop\All_mricgcm3_files\45\Fall45\777GTY78". Yet, as I've shown in the images, all indications are that it knows what file it is working with. There are no "blank spaces" in the pathname.
I tried taking the underscores out of the folder "All_mricgcm3_files".
I moved the line newFileName = Sheetname.Range("A2").Value to come before the strPath line.
Where is this 8-digit alphanumeric "filename" coming from?? (See error code, first image.)
Ok, it was a very simple thing, in case anyone else runs into this problem.
Took me two days to find out though --> I had somehow dropped a folder layer in the path name. The catch? The alphanumeric string was showing up at the end of the path name, not where the folder layer was missing. That's why I was thrown off because my focus was on the ending.
When I added that folder\ back in, I had no more problem with saving and the macro ran fine.

VBA reading non-english characters causes errors

I am using a macro that reads every excel file in one folder and subfolders and refreshes it by opening the file and closing it with 'save changes' attribute as True. The problem is that VBA doesn't read non-english letters correctly and it causes error when trying to save the spreadsheet. My region settings in Windows control panel are correct. When I try to use the beta option of using Unicode UTF-8 for every language it works but that causes a lot of other programs I use to display some weird characters. The language I try to incorporate is polish. Any idea what to do?
Sub RefreshExcelDocs()
Const startFolder As String = "C:\Users\Patryk\Downloads\Przykład óżęą\Folder\"
Dim file As Variant, wb As Excel.Workbook
For Each file In Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & startFolder & "*.xl*"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
Set wb = Workbooks.Open(file)
wb.Close SaveChanges:=True '
Set wb = Nothing
Next
End Sub

How to programmatically export and import code into Excel worksheet?

We will put 100s of Excel worksheets out in the field this year. The code periodically needs to be updated when bugs are found. For last year's effort, I was able to dynamically have workbooks pull updates for .bas files. This year I want to dynamically have workbooks pull updates for the code embedded in the worksheets too.
EXPORT CODE
The export code is pretty simple, but there are artifacts in the .txt files
Sub SaveSoftwareFile(path$, name$, ext$)
ThisWorkbook.VBProject.VBComponents(name).Export path & name & ext
Example Call: SaveSoftwareFile path, "ThisWorkbook", ".txt"
The problem is that the export has a lot of header information that I don't care about (in red). I just want the part in blue. Is there switch that allows me not to save it, or do I have to manually go into the export and remove it myself?
IMPORT CODE
The import code is pretty straight forward too, but it causes the error "Can't enter break mode at this time", and I'm struggling to figure out the right path forward. If I manually try and delete this code, Excel is also unhappy. So maybe my approach is altogether incorrect. Here's the code:
Sub UpgradeSoftwareFile(path$, name$, ext$)
Dim ErrorCode%, dest As Object
On Error GoTo errhandler
Select Case ThisWorkbook.VBProject.VBComponents(name).Type
Case 1, 3 'BAS, FRM
<Not relevant for this discussion>
Case 100 'Worksheets
Set dest = ThisWorkbook.VBProject.VBComponents(name).codemodule
dest.DeleteLines 1, dest.CountOfLines 'Erase existing | Generates breakpoint error
dest.AddFromFile path & name & ext '| Also generates breakpoint error
End Select
Example Call: UpgradeSoftwareFile path, "ThisWorkbook", ".txt"
Thanks in advance for your help
Please, try the next way of exporting and you will not have the problem any more:
Sub SaveSoftwareFile(path$, sheetCodeModuleName$, FileName$)
Dim WsModuleCode As String, sCM As VBIDE.CodeModule, strPath As String, FileNum As Long
Set sCM = ThisWorkbook.VBProject.VBComponents(sheetCodeModuleName).CodeModule
WsModuleCode = sCM.Lines(1, sCM.CountOfLines)
'Debug.Print WsModuleCode
strPath = ThisWorkbook.path & "\" & FileName
FileNum = FreeFile
Open strPath For Output As #FileNum
Print #FileNum, WsModuleCode
Close #FileNum
End Sub
You can use the above Sub as following:
Sub testSaveSheetCodeModule()
Dim strPath As String, strFileName As String, strCodeModuleName As String
strPath = ThisWorkbook.path
strFileName = "SheetCode_x.txt"
strCodeModuleName = Worksheets("Test2").codename 'use here your sheet name
SaveSoftwareFile strPath, strCodeModuleName, strFileName
End Sub
Now, the created text file contains only the code itself, without the attributes saved by exporting the code...
Import part:
"Can't enter break mode at this time" does not mean that it is an error in the code. There are some operations (allowed only if a reference to Microsoft Visual Basic for Applications Extensibility ... exists) in code module manipulation, which cannot simple be run step by step. VBA needs to keep references to its VBComponents and it looks, it is not possible when changes in this area and in this way are made.
The import code is simple and it must run without problems. You must simple run the code and test its output...

Automatical repair of number of corrupted .xlsx files via VBA script

I have a number of corrupted .xlsx files in a directory.
I want to open every single file for repair and save it with the same name via VBA script.
I`ve tried following piece of code to solve this problem:
Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = ActiveWorkbook.Path & "\output\"
Filename = Dir(Pathname & "*.xlsx")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename, CorruptLoad:=xlRepairFile)
wb.Close SaveChanges:=True
Filename = Dir()
Loop
End Sub
But this code only repairs first file and opens windows explorer to save file manualy.
Is there a way to perform repair and save all files with the same name in the same folder automatically?
I haven't touched VBA in years, but there is an explicit wb.SaveAs method you can call.
Have you set Application.DisplayAlert = False? Your codes seems fine. You just have to turn it on later.

ThisWorkbook Not Working in Excel 2018?

I have recently encountered a problem where a macro that used to work in previous versions of Excel has stopped functioning as intended. The macro, when functional, opens each file in a specific folder and copies some of its data and pastes it into another file which it opened.
Since this macro is run from within a file in the folder, it was previously programmed to not attempt to re-open the file, using the code below:
' Create a new workbook and set a variable to the first sheet.
' Set SummarySheet =
Workbooks.Open ("[Redacted]")
' agg_wkb_name = ActiveWorkbook
lrowcount = ActiveWorkbook.Worksheets("scheduled hours").UsedRange.Rows.Count
ActiveWorkbook.Worksheets("scheduled hours").Range("A2:bz" & lrowcount).Delete
' Modify this folder path to point to the files you want to use.
FolderPath = "[Redacted]"
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 2
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.xl*")
' Loop until Dir returns an empty string.
Do While FileName <> ""
' Open a workbook in the folder
If FolderPath & FileName = ThisWorkbook.FullName Then
Set WorkBk = ThisWorkbook
Else
Set WorkBk = Workbooks.Open(FolderPath & FileName, , True)
End If
However, after our computers and programs were updated to Win10 and Excel 2016, this macro began attempting to also open the workbook running the file ('ThisWorkbook'). When you attempt to say "no, I don't want to re-open the file", it stops the Macro, and when you say "yes", Excel crashes.
I attempted to segregate the code, to pull the data from 'ThisWorkbook' differently than pulling it from the various other workbooks in the folder. The new section of code reads:
Do While FileName <> ""
If Not (FolderPath & FileName = ThisWorkbook.Path & ThisWorkbook.Name) Then
Set WorkBk = Workbooks.Open(FolderPath & FileName, , True)
End If
Unfortunately, the very same error still occurs. I'm at a loss - my best guess is that something changed in the way 'ThisWorkbook' functions between the last version of Excel and the current one.
So, it turns out that a system administrator had re-mapped the folder to a drive on my computer. I fixed it by not having the code look at the file location for comparison, only the name, since that's all that changes once you get into the folder.
If anyone ever runs into this, or has a similar situation where they are opening all files in a folder except the one that is currently open - don't bother with the filepath. Just use the name.

Resources