I have the following problem:
To save the Worksheet in a .txt file, I wrote this sub:
Sub SaveFile()
Dim ans As Long
Dim sSaveAsFilePath As String
Dim VPname As String
VPname = Worksheets(3).Cells(2, 1)
On Error GoTo ErrHandler:
sSaveAsFilePath = ActiveWorkbook.Path & "\" & VPname & ".txt"
If Dir(sSaveAsFilePath) <> "" Then
ans = MsgBox("Datei " & sSaveAsFilePath & " existiert bereits. Überschreiben?", vbYesNo + vbExclamation)
If ans <> vbYes Then
Exit Sub
Else
Kill sSaveAsFilePath
End If
End If
Worksheets(3).Copy '//Copy sheet 3 to new workbook
ActiveWorkbook.SaveAs sSaveAsFilePath, xlTextWindows '//Save as text (tab delimited) file
If ActiveWorkbook.name <> ThisWorkbook.name Then '//Double sure we don't close this workbook
ActiveWorkbook.Close False
End If
MsgBox ("Worksheet wurde erfolgreich als txt-Datei gespeichert!")
My_Exit:
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume My_Exit
End Sub
In this worksheet, the cells with text content have to have quotation marks (e.g. "example"). When I open the .txt-file, all these entrys have three quotation marks instead of one ("""example""").
Do you know how to fix this?
Thanks a lot :)
Welcome to stackoverflow! It is really useful, to make a small question, that is replicable by the others - read more here - https://stackoverflow.com/help/mcve Thus, it would be easy for you to search as well.
In your case, a minimal and verifyable example would be like this:
Option Explicit
Public Sub TestMe()
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\new1.txt", _
FileFormat:=xlTextWindows
End Sub
Then, if you use the search engine, you would find that there is already some answer of it here:
Saving a Excel File into .txt format without quotes
:)
Related
The macro I made saves a template workbook as two separate files. One is saved per test (Location1,2,3, or 4) then is used in another macro to use the data from each test. The Second is a raw data file kept for back up. Now the issue is every time I run the test per location and run this macro it ask me if I want to save over the previous test. How can I tell it to say yes with out asking. Same for the do i want to save this workbook as a macro free workbook. What do i have to put in my code and where should i put it? Any helps is much appreciated.
Thanks
Solved Code:
Sub Auto_Open()
With Range("A30")
.Value = Time
.NumberFormat = "h-mm-ss AM/PM"
End With
Dim FileName As String
Dim FilePath As String
Dim FileDate As String
MyNote = "Is Cell 'B27' Overview Information" & SavePath & " Location1,2,3,or 4?"
Answer = MsgBox(MyNote, vbQuestion + vbYesNo)
If Answer = vbYes Then
FilePath = "C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test"
FileName = Sheets("Data").Range("B27").Text
Application.DisplayAlerts = False
ThisWorkbook.SaveAs FileName:=FilePath & "\" & FileName
Dim FileCopyName As String
Dim FileCopyPath As String
Dim FileTime As String
FilePath = "C:\Users\aholiday\Desktop\Backup"
FileName = Sheets("Data").Range("B27").Text
FileTime = Sheets("Data").Range("A30").Text
ThisWorkbook.SaveAs FileName:=FilePath & "\" & FileName & FileTime & ".xlsx", FileFormat:=xlOpenXMLWorkbook
MsgBox "File was saved!"
MsgBox "Ready for Next Test, Please Exit."
Application.DisplayAlerts = True
Else
MsgBox "File was not saved, Please Use Location_1,2,3or,4 Durring SIG ATM Test"
End If
End Sub
Add Application.DisplayAlerts = False before you try and save. Remember to turn in back to True after you've saved.
ConflictResolution should be xlLocalSessionChanges to not see the prompt
ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
from
How to use workbook.saveas with automatic Overwrite
The following VBA code is meant to run on MS Office 2003. Because that's what our multi-billion dollar corporation gives us to work with. =)
The good news. It works perfectly if I'm editing code in the IDE and hit save. Same if I'm working on the spreadsheet itself. Creates a backup folder if none exists, and saves a dated backup copy in it.
The bad news. When I run the main macro (too large to post), the code below executes but does not save a backup copy. The event is called correctly. In fact, it will create a backup folder if none exists. Every line gets run. The variables are all correct. Error handling works.
Simply put, ThisWorkbook.SaveCopyAs won't work if the main macros is running and calls ThisWorkbook.Save.
I only learned VBA a couple months ago for this particular project, so apologies if there is something obvious. However, I read all the relevant MSDN documentation and Googled like mad, but nothing came up.
Thanks in advance for your assistance.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'********************************************************************
'Purpose: Triggered by ThisWorkbook.BeforeSave event
' Creates backup folder and saves date appended copies
'********************************************************************
Dim strBackupPath As String 'Path to Backup Folder
Dim strFarkPath As String 'Path to running workbook
Dim strBackupName As String 'Filename of backup
Dim strFullName As String 'Full path & filename of running workbook
Dim strBackupExtension As String 'Extension of backup
Dim strDestination As String 'Full path & filename of backup
Dim strDrive As String 'Drive letter
strFarkPath = Application.ActiveWorkbook.Path
strDrive = Left(strFarkPath, 1)
strBackupPath = strFarkPath & "\_Backups"
strBackupName = "\Backup-" & Year(Now) & "-" & Month(Now) & "-" & Day(Now)
strFullName = Application.ActiveWorkbook.FullName
strBackupExtension = Right(strFullName, Len(strFullName) - InStrRev(strFullName, ".", -1, vbTextCompare) + 1)
strDestination = strBackupPath & strBackupName & strBackupExtension
On Error GoTo Incorrect
If Len(Dir(strBackupPath, vbDirectory)) = 0 Then
MkDir strBackupPath
End If
Application.DisplayAlerts = False
ThisWorkbook.SaveCopyAs Filename:=strDestination
Application.DisplayAlerts = True
Exit Sub
Incorrect:
MsgBox "Unable to back record keeper up. Next time, please run the program from a location where you can read and write files.", vbCritical + vbOKOnly
End Sub
Here's the last part of your existing sub, modified to create a copy.
Note you cannot use the built-in FileCopy to make the copy (you'll get "Permission Denied")
On Error GoTo Incorrect
If Len(Dir(strBackupPath, vbDirectory)) = 0 Then
MkDir strBackupPath
End If
Application.DisplayAlerts = False
Application.EnableEvents = False
ThisWorkbook.Save
CreateObject("scripting.filesystemobject").copyfile _
ThisWorkbook.FullName, strDestination
Application.EnableEvents = True '<<<<
Application.DisplayAlerts = True
Exit Sub
Incorrect:
Application.EnableEvents = True 'never leave this False!
MsgBox "Unable to back record keeper up. Next time, please run the program from a location where you can read and write files.", vbCritical + vbOKOnly
End Sub
I have a savecopyas code at an at close prompt code that works, but if someone opens the copied document then trys to close it, the same copied VBA script within itself will try running the savecopyas to it's own path, resulting in an error/debug messagebox. My first idea would be to open the copied workbook in the background and delete all the VBA scripts then close and save as read only, however I also had a thought maybe I should just try to change the copied workbook to an .xlsx instead of it's original version .xslm format.
Any suggestions?
Here is what I have so far, but my question I guess is how do I open the copied workbook(not the original) and delete the VBA scripts in it in the background(not visible) then save and close?
Any help/suggestions would be much appreciated.
This is in my 'ThisWorkBook' module:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not Me.Saved Then
Msg = "Do you want to save the changes you made to "
Msg = Msg & Me.Name & "?"
Ans = MsgBox(Msg, vbQuestion + vbYesNoCancel)
Select Case Ans
Case vbYes
Me.Save
Case vbNo
Me.Saved = True
Case vbCancel
Cancel = True
Exit Sub
End Select
End If
Call Auto_Save 'Change this to your own subroutine
End Sub
This is in my 'Module1':
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim backupfolder As String
backupfolder = "C:\Users\" & Environ("username") & "\Documents\John's Backup\"
ThisWorkbook.SaveCopyAs Filename:=backupfolder & ThisWorkbook.Name
End Sub
Sub Auto_Save()
Dim savedate
savedate = Date
Dim savetime
savetime = Time
Dim formattime As String
formattime = Format(savetime, "hh.MM.ss")
Dim formatdate As String
formatdate = Format(savedate, "DD - MM - YYYY")
Application.DisplayAlerts = False
Dim backupfolder As String
backupfolder = "C:\Users\" & Environ("username") & "\Documents\John's Backup\"
ActiveWorkbook.SaveCopyAs Filename:=backupfolder & ActiveWorkbook.Name
ActiveWorkbook.Save
Application.DisplayAlerts = True
MsgBox "Backup Run. Please Check at: " & backupfolder & " !"
End Sub
You nailed it - remove the macros by saving the workbook as an xlsx file (assuming you are using Excel 2007+).
If I understand your situation correctly, the workbook backup is saved when the workbook closes. So, I would save the workbook, then SaveAs the workbook, and then close the workbook.
One implementation could look like this:
ActiveWorkbook.Save
' Note that xlOpenXMLWorkbook = 41
ActiveWorkbook.SaveAs backupfolder & ActiveWorkbook.Name, FileFormat:= xlOpenXMLWorkbook
Separately, the folder location could fail if a user is on an older version of Windows (or if a future version has a different location for the Documents folder). So, instead of this:
backupfolder = "C:\Users\" & Environ("username") & "\Documents\John's Backup\"
do something like this:
Dim WshShell as Object
Set WshShell = CreateObject("WScript.Shell")
backupfolder = WshShell.SpecialFolders("MyDocuments") + "\John's Backup\"
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
This question has been edited due to lengthy comments and updates from proposed answers.
As requested here is module 13;
Sub SaveInFormat()
Application.DisplayAlerts = False
Workbooks.Application.ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\jammil\Desktop\AutoFinance\ProjectControl\Data\" & Format(Date, "yyyymm") & "DB" & ".xlsx", leFormat:=51
Application.DisplayAlerts = True
End Sub
Also there are issues with the errorhandling, I know I've gone wrong with it but I'm more interested in fixing the close function at the moment before I get into it. Here is the error handling code that needs some work
Sub test()
Dim wk As String, yr As String, fname As String, fpath As String
Dim owb As Workbook
wk = ComboBox1.Value
yr = ComboBox2.Value
fname = yr & "W" & wk
fpath = "C:\Documents and Settings\jammil\Desktop\AutoFinance\ProjectControl\Data"
owb = Application.Workbooks.Open(fpath & "\" & fname)
On Error GoTo ErrorHandler:
ErrorHandler:
If MsgBox("This File Does Not Exist!", vbRetryCancel) = vbCancel Then Exit Sub Else Call Clear
'Do Some Stuff
Call Module13.SaveInFormat
owb.Close
this is your test code plus my changing of the file path and name
After discussion posting updated answer:
Option Explicit
Sub test()
Dim wk As String, yr As String
Dim fname As String, fpath As String
Dim owb As Workbook
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
End With
wk = ComboBox1.Value
yr = ComboBox2.Value
fname = yr & "W" & wk
fpath = "C:\Documents and Settings\jammil\Desktop\AutoFinance\ProjectControl\Data"
On Error GoTo ErrorHandler
Set owb = Application.Workbooks.Open(fpath & "\" & fname)
'Do Some Stuff
With owb
.SaveAs fpath & Format(Date, "yyyymm") & "DB" & ".xlsx", 51
.Close
End With
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
End With
Exit Sub
ErrorHandler: If MsgBox("This File Does Not Exist!", vbRetryCancel) = vbCancel Then
Else: Call Clear
End Sub
Error Handling:
You could try something like this to catch a specific error:
On Error Resume Next
Set owb = Application.Workbooks.Open(fpath & "\" & fname)
If Err.Number = 1004 Then
GoTo FileNotFound
Else
End If
...
Exit Sub
FileNotFound: If MsgBox("This File Does Not Exist!", vbRetryCancel) = vbCancel Then
Else: Call Clear
I'll try and answer several different things, however my contribution may not cover all of your questions. Maybe several of us can take different chunks out of this. However, this info should be helpful for you. Here we go..
Opening A Seperate File:
ChDir "[Path here]" 'get into the right folder here
Workbooks.Open Filename:= "[Path here]" 'include the filename in this path
'copy data into current workbook or whatever you want here
ActiveWindow.Close 'closes out the file
Opening A File With Specified Date If It Exists:
I'm not sure how to search your directory to see if a file exists, but in my case I wouldn't bother to search for it, I'd just try to open it and put in some error checking so that if it doesn't exist then display this message or do xyz.
Some common error checking statements:
On Error Resume Next 'if error occurs continues on to the next line (ignores it)
ChDir "[Path here]"
Workbooks.Open Filename:= "[Path here]" 'try to open file here
Or (better option):
if one doesn't exist then bring up either a message box or dialogue
box to say "the file does not exist, would you like to create a new
one?
you would most likely want to use the GoTo ErrorHandler shown below to achieve this
On Error GoTo ErrorHandler:
ChDir "[Path here]"
Workbooks.Open Filename:= "[Path here]" 'try to open file here
ErrorHandler:
'Display error message or any code you want to run on error here
Much more info on Error handling here: http://www.cpearson.com/excel/errorhandling.htm
Also if you want to learn more or need to know more generally in VBA I would recommend Siddharth Rout's site, he has lots of tutorials and example code here:
http://www.siddharthrout.com/vb-dot-net-and-excel/
Hope this helps!
Example on how to ensure error code doesn't run EVERYtime:
if you debug through the code without the Exit Sub BEFORE the error handler you'll soon realize the error handler will be run everytime regarldess of if there is an error or not. The link below the code example shows a previous answer to this question.
Sub Macro
On Error GoTo ErrorHandler:
ChDir "[Path here]"
Workbooks.Open Filename:= "[Path here]" 'try to open file here
Exit Sub 'Code will exit BEFORE ErrorHandler if everything goes smoothly
'Otherwise, on error, ErrorHandler will be run
ErrorHandler:
'Display error message or any code you want to run on error here
End Sub
Also, look at this other question in you need more reference to how this works:
goto block not working VBA