I need to import a file from the desktop. However, I need this to be used by different users.
Below is how it is written to work on "Mark's" desktop. How do Imake it so it will work on any users desktop?
Application.CutCopyMode = False
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\Mark\Desktop\next.txt", Destination:=Range("$A$1"))
.Name = "next"
.FieldNames = True
Same issue when saving the file at the end:
Sheets("Loader").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
ActiveWorkbook.SaveAs Filename:="C:\Users\Mark\Desktop\Load_File" & Format(Now(), "DD-MMM-YYYY hh mm AMPM") & ".CSV", _
FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = True
End With
End Sub
I wrote code that saves the book in a specific format. After saving, the book is only available in read-only mode. What could be the error?
Sub SaveAs()
Application.DisplayAlerts = False
Dim relativePath As String
relativePath = ThisWorkbook.Path & "\" & ActiveWorkbook.Name
ActiveWorkbook.SaveAs Filename:=relativePath, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False, ReadOnlyRecommended:=False, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
Application.DisplayAlerts = True
End Sub
My goal is to open multiple excel files from input folder and convert them to .csv in output folder. I am facing minor issues where
code converts .xlsx to .csv , converts .xls to .csv but in output
folder, it stores .csv and .xls files. I can't figure out why .xls
files are also getting stored. I only wish to store .csv files
I only want to convert data from excel 'Sheet1' but the code is
converting data from an active sheet. How to specify to convert
data only from 'Sheet1'?
Option Explicit
Sub ImportMultipleCsvFile()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Dim InputCsvFile As Variant
Dim InputFolder As String, OutputFolder As String
InputFolder = "C:\Users\excel_format"
OutputFolder = "C:\Users\csv_format"
InputCsvFile = Dir(InputFolder & "\*.xl??")
While InputCsvFile <> ""
Workbooks.OpenText Filename:=InputFolder & "\" & InputCsvFile, DataType:=xlDelimited, Comma:=True
ActiveWorkbook.SaveAs Filename:=OutputFolder & "\" & Replace(ActiveWorkbook.Name, ".xlsx", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:=OutputFolder & "\" & Replace(ActiveWorkbook.Name, ".xls", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
InputCsvFile = Dir
Wend
Application.Calculation = xlCalculationAutomatic
End Sub
If you change this:
ActiveWorkbook.SaveAs Filename:=OutputFolder & "\" & Replace(ActiveWorkbook.Name, ".xlsx", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:=OutputFolder & "\" & Replace(ActiveWorkbook.Name, ".xls", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
to that:
--- to remove VBA codeblocks from Workbook before saving them as .csv, I have used this stackoverflow answer, then I checked it to make sense by using the info from here ---
Dim StartWb As Workbook
Dim TempWb As Workbook
Set StartWb = ActiveWorkbook
Set TempWb = Application.Workbooks.Add
StartWb.Worksheets("Sheet1").Copy Before:=TempWb.Worksheets(1)
If TempWb.Worksheets.Count > 1 Then
Do While (TempWb.Worksheets.Count > 1)
TempWb.Worksheets(TempWb.Worksheets.Count).Delete
Loop
End If
' ----- This is new to delete the codeblocks from your Sheets -----------
Dim Element As Object
For Each Element In TempWb.VBProject.VBComponents
'For Each Item In Element.Collection ' This For loop wasn't needed at the and but I forgot it in
Element.CodeModule.DeleteLines 1, Element.CodeModule.CountOfLines
'Next ' It has most likely thrown up Undeclared Variable error with Option Eplicit
Next
' -----------------------------------------------------------------------
If InStr(StartWb.Name, ".xlsx") Then
TempWb.SaveAs Filename:=OutputFolder & "\" & Replace(StartWb.Name, ".xlsx", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
ElseIf InStr(StartWb.Name, ".xls") Then
TempWb.SaveAs Filename:=OutputFolder & "\" & Replace(StartWb.Name, ".xls", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
End If
TempWb.Close (xlNo)
then you will only get your .csv file saved, as well as it will only contain that first sheet.
I would also put these:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
at the end of your code before or after:
Application.Calculation = xlCalculationAutomatic
Also swap this:
ActiveWorkbook.Close
to that:
StartWb.Close (xlNo)
To remove code from workbooks by code you have to change settings in Excel:
I tried to search and put together a code to fit my purpose.
Sub save()
ActiveWorkbook.SaveAS Filename:="C:\-docs\cmat\Desktop\New folder\ck.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
End Sub
How to edit this to:
Instead of naming the saved file ck.xls, generate the filename from the worksheet cells C5 and C8, with a space in the middle.
try
Sub save()
ActiveWorkbook.SaveAS Filename:="C:\-docs\cmat\Desktop\New folder\" & Range("C5").Text & chr(32) & Range("C8").Text &".xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
End Sub
If you want to save the workbook with the macros use the below code
Sub save()
ActiveWorkbook.SaveAs Filename:="C:\Users\" & Environ$("username") & _
"\Desktop\" & Range("C5").Text & Chr(32) & Range("C8").Text & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, Password:=vbNullString, WriteResPassword:=vbNullString, _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
if you want to save workbook with no macros and no pop-up use this
Sub save()
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\Users\" & Environ$("username") & _
"\Desktop\" & Range("C5").Text & Chr(32) & Range("C8").Text & ".xls", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = True
End Sub
Ok, at that time got it done with the help of a friend and the code looks like this.
Sub Saving()
Dim part1 As String
Dim part2 As String
part1 = Range("C5").Value
part2 = Range("C8").Value
ActiveWorkbook.SaveAs Filename:= _
"C:\-docs\cmat\Desktop\pieteikumi\" & part1 & " " & part2 & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
How do I edit this part (FileFormat:= _ xlOpenXMLWorkbookMacroEnabled) for it to save as Excel 97-2013 Workbook, have tried several variations with no success.
Thankyou
Seems, that I found the solution, but my idea is flawed. By doing this FileFormat:= _ xlOpenXMLWorkbook, it drops out a popup saying, the you cannot save this workbook as a file without Macro enabled. So, is this impossible?
I have *.asc files to open, reformat, and then save as an Excel file with the same name as the original (with the xls extension).
I used the Macro Recorder and code I found online to open individual files and reformat them as desired. That part of the code works.
I cannot save as an Excel file. It gives me the Run Time error of 1004 Method ‘SaveAs’ of object ‘_Workbook’ failed. I have tried lots of different code I found online (still in there, just commented out) but none work.
Two questions:
Can you offer suggestions to fix the SaveAs problem?
Can you offer suggestions of how to automate the opening and saving of all the files in one folder?
Here is the code I have:
Sub OpenFormatSave()
'
' OpenFormatSave Macro
'
Dim StrFileName As String
Dim NewStrFileName As String
ChDir _
"C:\Users\Owner\Documents\work_LLRS\GoM\NASA_data\Satellite_files_GoM_3Dec2012"
StrFileName = Application.GetOpenFilename("NASA Files (*.asc), *.asc")
If TypeName(StrFileName) <> "Boolean" Then
Workbooks.OpenText Filename:=StrFileName, _
Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True
End If
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Year"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Day_of_Year"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Longitude"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Latitude"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Chla_mg_m-3"
Range("F1").Select
ActiveCell.FormulaR1C1 = "POC_mmolC_m-3"
Range("G1").Select
ActiveCell.FormulaR1C1 = "SPM_g_m-3"
Range("H1").Select
ActiveCell.FormulaR1C1 = "aCDOM355_m-1"
Range("I1").Select
ActiveCell.FormulaR1C1 = "DOC_mmolC_m-3"
Range("J1").Select
ActiveCell.FormulaR1C1 = "L2_flags"
Columns("A:B").Select
Selection.NumberFormat = "0"
Columns("C:D").Select
Selection.NumberFormat = "0.0000"
Columns("E:E").Select
Selection.NumberFormat = "0.000"
Columns("F:F").Select
Selection.NumberFormat = "0.0"
Columns("G:H").Select
Selection.NumberFormat = "0.000"
Columns("I:I").Select
Selection.NumberFormat = "0.0"
Columns("J:J").Select
Selection.NumberFormat = "0.00E+00"
'Mid(StrFileName, 1, InStrRev(StrFileName, ".")) = "xlsm"
'With ActiveWorkbook
'NewStrFileName = Replace(.StrFileName, ".asc", ".xls")
' .SaveAs Filename:=FullName, FileFormat:=xlsx, AddToMRU:=False
' .Close SaveChanges:=True
'End With
StrFileName = ThisWorkbook.Name
GetName:
StrFileName = Application.GetSaveAsFilename(NewStrFileName, _
fileFilter:="(*.xlsm), *.xlsm, (*.xlsx), *.xlsx,(*.xls), *.xls")
' FileMonth is the Workbook name, filter options to save a older version file
'If Dir(NewStrFileName) = "" Then
' ActiveWorkbook.SaveAs NewStrFileName
'Else
' If MsgBox("That file exists. Overwrite?", vbYesNo) = vbNo Then GoTo GetName
' Application.DisplayAlerts = False
' ActiveWorkbook.SaveAs Filename:=NewStrFileName, FileFormat:=xlsx, AddToMRU:=False
'Application.DisplayAlerts = True
'End If
'ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.SaveAs Filename:=NewStrFileName, FileFormat:=xlsx, CreateBackup:=False
'With ThisWorkbook
'FullName = Replace(.StrFileName, ".asc", ".xlsx")
'.Save
'.SaveAs StrFileName, FileFormat:=xlsx
'.Close
'SaveChanges:=True
'End With
'StrFileName = Split(ActiveWorkbook.FullName, ".xls")(0)
'ActiveWorkbook.SaveAs Filename:="...", FileFormat:=xlsx, AddToMRU:=False
'ActiveWorkbook.Close SaveChanges:=True
'ActiveWorkbook.Save
End Sub
Change the FileFormat portion of your SaveAs method to this:
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
To iterate through all the files in a folder, you have two options.
Use the built-in VBA Dir function.
Use methods in FileSystemObject.
I'll give an example of Dir because it doesn't require adding a reference in your VBA project. Unfortunately the Dir interface is a lot less intuitive and less modern than FileSystemObject.
Dim path As String
path = Dir("C:\Users\example\Documents\AscFiles\*.asc")
Do
If path = vbNullString Then Exit Do
' do something with path here
Debug.Print path
path = Dir
Loop
You have two variables StrFileName (presumably intended as the current filename) and NewStrFileName (presumably intended to be the new filename).
In this piece of code:
StrFileName = Application.GetSaveAsFilename(NewStrFileName, _
fileFilter:="(*.xlsm), *.xlsm, (*.xlsx), *.xlsx,(*.xls), *.xls")
you have used these variables the wrong way round. The suggested filename when the "Save As" dialog opens is based on NewStrFileName but this has never been given a value and is thus an empty string "". The value chosen by the user is then saved into StrFileName
When you come to save the file with this code:
ActiveWorkbook.SaveAs Filename:=NewStrFileName, FileFormat:=xlsx, _
CreateBackup:=False
the NewStrFileName variable still contains "" and thus you are trying to save a file without giving it a name which obviously produces an error.
For a simple fix, just swap the two variables in the call to GetSaveAsFilename:
NewStrFileName = Application.GetSaveAsFilename(StrFileName, _
fileFilter:="(*.xlsm), *.xlsm, (*.xlsx), *.xlsx,(*.xls), *.xls")
This is not the best way to achieve what you want but it should at least work
here is a very simply code to convert a folder of ASC files to Excel files. It also works with CSV files. So all you have to do is change the .asc to .csv
Just make sure you set the delimiter to TAB wherever you are getting the data from.
Sub import_ascFile()
Dim file As FileDialog
Dim filePath As String
Dim text As String
Dim wsheet As String
Application.DisplayAlerts = False
Application.StatusBar = True
wsheet = ActiveWorkbook.Name
Set file = Application.FileDialog(msoFileDialogFolderPicker)
file.Title = "Folder Selection:"
If file.Show = -1 Then
filePath = file.SelectedItems(1)
Else
Exit Sub
End If
If Right(filePath, 1) <> "\" Then filePath = filePath + "\"
text = Dir(filePath & "*.asc")
Do While text <> ""
Application.StatusBar = "Converting: " & text
Workbooks.Open Filename:=filePath & text
ActiveWorkbook.SaveAs Replace(filePath & text, ".asc", ".xlsx", vbTextCompare), xlWorkbookDefault
ActiveWorkbook.Close
Windows(wsheet).Activate
text = Dir
Loop
Application.StatusBar = False
Application.DisplayAlerts = True
End Sub