Get Data in VBA that can be used by any user - excel

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

Related

VBA Save As CSV & 97-2003

I am not the best at VBA and a third-party programme has suddenly stopped working strangely. I am attempting to save as csv and save as 97-2003 excel file.
This was previously working but now I am receiving a Error 1004 message. Can anybody please help me?
Application.DisplayAlerts = False
xls = ActiveWorkbook.FullName
Length = Len(xls) - 3
CSV = Left(xls, Length) & "csv"
dlist = Left(xls, Length - 1)
ActiveWorkbook.SaveAs Filename:= _
CSV, FileFormat:=xlCSV, _
CreateBackup:=False
ActiveWorkbook.SaveAs Filename:= _
xls, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
Application.DisplayAlerts = True
ActiveSheet.Name = "TITLEBLOCK_DRAWING LIST"
ActiveCell.Select
MsgBox "CSV and XLS files saved"
Hope this helps...
Sub SaveTwoFileTypes()
Dim xlsFileName As String
Dim lengthXlsFileName As Integer
Dim csvFileName As String
Dim dlist As String
Application.DisplayAlerts = False
'Get workbook name (e.g. "https://d.docs.live.net/somealpanumericstring/Documents/Book2.xls")
xlsFileName = ActiveWorkbook.FullName
'Get length of name (e.g. 60), then subtract 4 for the period and 3-digit extension
lengthXlsFileName = Len(xlsFileName) - 4
'Tack on the .csv extension after "https://d.docs.live.net/somealpanumericstring/Documents/Book2"
csvFileName = Left(xlsFileName, lengthXlsFileName) & ".csv"
'No idea why this is here...
dlist = Left(xlsFileName, lengthXlsFileName - 1)
'Save both formats
ActiveWorkbook.SaveAs Filename:= _
csvFileName, FileFormat:=xlCSV, _
CreateBackup:=False
ActiveWorkbook.SaveAs Filename:= _
xlsFileName, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
Application.DisplayAlerts = True
'Name the active worksheet
ActiveSheet.Name = "TITLEBLOCK_DRAWING LIST"
ActiveCell.Select
'Display a message box with this text
MsgBox "CSV and XLS files saved"
End Sub

SaveAs method saves workbook as ReadOnly

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

Convert multiple Excel sheets to CSV

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:

Excel VBA saveas csv but the file output is the wrong format

HI i am new to vba and am wondering why the file output when i attempted this code just a default file and not csv. I created this code via macro recording. I want to be able to save the file as csv after working on the sheet. My code is as follows
Sub Done()
Sheets("Test").Select
Range("A2:M3").Select
Range("A2:M3").Copy
Range("A2").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets("Test").Select
ActiveWorkbook.Save
ActiveWorkbook.SaveAs Filename:= _
Application.GetSaveAsFilename, FileFormat:= _
xlCSV, CreateBackup:=False
ActiveWorkbook.Close SaveChanges:=False
End Sub
To save the file as csv try:
Sub Done()
Sheets("Test").Select
Range("A2:M3").Select
Range("A2:M3").Copy
Range("A2").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets("Test").Select
ActiveWorkbook.Save
ActiveWorkbook.SaveAs Filename:="C:\filename.csv", _
FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close SaveChanges:=False
End Sub
Change file path and file name as required.
EDIT: Using SaveAs Dialog Box
________________________________________________________________________________
Try this:
Sub Done()
Sheets("Test").Select
Range("A2:M3").Select
Range("A2:M3").Copy
Range("A2").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets("Test").Select
ActiveWorkbook.Save
fname = Application.GetSaveAsFilename(InitialFileName:="Test", FileFilter:="CSV (Comma delimited) (*.csv), *.csv", Title:="Save As")
ActiveWorkbook.SaveAs Filename:=fname, FileFormat:=xlCSV
End Sub
When you call ActiveWorkbook.SaveAs, you need to replace "enter code here" with a filename:
ActiveWorkbook.SaveAs Filename:= "MyFilename.csv"_
FileFormat:= xlCSV, CreateBackup:=False _
ActiveWorkbook.Close SaveChanges:=False
Once you have a filename, you can save the file. You can choose any filename that you want, and simply use that in place of MyFilename.csv in this example.

Saving Excel workbook to constant path with filename from two fields

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?

Resources