I currently have a text file (c:\temp\temp.txt) and I want to be able to use VBA to edit the file and and wipe out the 3rd row of string data (it's variable so I don't know what it will say) but keep the rest of the rows of text intact.
I've been trying to figure it out, it seems like I have to open the file, save the entire file as a string, then close and reopen the file and edit the string and save?
Any help would be much appreciated!
Your pseudocode is pretty much what you need to do. I'd personally split on a newline and write individual lines back:
Private Sub KillLineThree(filepath As String)
With CreateObject("Scripting.FileSystemObject")
Dim lines() As String
With .OpenTextFile(filepath)
lines = Split(.ReadAll, vbCrLf)
.Close
End With
Dim i As Long
With .CreateTextFile(filepath)
For i = LBound(lines) To UBound(lines)
If i <> 2 Then .WriteLine lines(i)
Next
.Close
End With
End With
End Sub
as a shorter a bit overkill version you can use Excel
Workbooks.Open "c:\temp\temp.txt"
Rows(3).Delete
DisplayAlerts = False
ActiveWorkbook.Close True
DisplayAlerts = True
Related
I'm fairly new to vba and i don't understand why i'm getting error 400.
I'm having this list. When i push the button, this list has to be deleted, you have to select a file and then the new list will be copied from this file to the list. The list is always the same amount of columns (A-J), variable in length (rows) so in column K i can put a formula to test some data in the list according to data on another sheet.
The problem is with the vba-line
.Sheets("Blad1").UsedRange.Copy LijstBP.Sheets("Blad1").Range("A1")
To test my code, I used a list on sheet "Blad2". My code works perfect with all lists i'm trying to copy. (ofcourse i had to change the code to "Blad2")
Now, the new lists are on sheet "Blad1". I only changed "Blad2" into "Blad1" and the error occurs...
Someone can spread a light on this? Thanks.
My entire code is:
Sub ImporteerData()
Dim LijstBP As Workbook
Dim Bron As Workbook
Set LijstBP = ActiveWorkbook
Call WisHuidigeLijst
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
Workbooks.Open .SelectedItems(1)
With ActiveWorkbook
.Sheets("Blad1").UsedRange.Copy LijstBP.Sheets("Blad1").Range("A1")
.Close False
End With
End If
End With
'Formule kopiëren
Set LijstBP = ActiveWorkbook
Range("K3").FillDown
End Sub
Private Sub WisHuidigeLijst()
Dim laatsteRij As Integer
laatsteRij = Cells(3, "A").End(xlDown).Row
ActiveSheet.Range("A1").Select
Range("A1:J" & laatsteRij).Value = ""
End Sub
I just solved the problem: My collegue, who makes the lists that i need to import, did something wrong: he created a list from columns A-I instead of A-J. By creating a new list from A-J, the whole thing works. My apologies for bothering with such stupidity :-) Last week, i didn't notice this. Thanks to all for trying to help me. –
I made the code to convert the values to the csv file but the problem is
that I'm not sure if this is the right way because this is the first time I even touched VBA macro! As seen in the image I provided, there is a button "Convert to CSV", when I tap it, the macro will call ExportWorksheetAndSaveAsCSV method and will convert the entire sheets contents into csv. However, it looks like it converts the entire sheet it'self.
What I want to do is the following steps .
1.Pass in the Sheet name as a parameter like ExportWorksheetAndSaveAsCSV("Sheet2"), so that it can be used as a file name. But I'm not sure how I can pass a parameter in function from the Buttton.
2.Convert the values in the columns E to I to CSV. If possible want to have the tites of the data show in the first row of the csv file.
I attached the image and the code so you can see. Some tips or examples will be really helpful! I would love to hear from you.
Public Sub ExportWorksheetAndSaveAsCSV()
Dim wbkExport As Workbook
Dim shtToExport As Worksheet
Dim book As String
Dim fileName As String
book = "Sheet1"
fileName = "test.csv"
Set shtToExport = ThisWorkbook.Worksheets(book) 'Export to CSV file
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = False
wbkExport.SaveAs fileName:="C:\Users\myStuff\Documents\" & fileName, FileFormat:=xlCSV
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False
End Sub
What is the best way to store a large text file (max 10Mb) in an Excel file?
I have a couple of requirements:
It has to be embedded so that the excel file can be moved and sent to a different computer and all the text files will follow.
It needs to be done from a macro.
And a macro needs to be able to read the file contents after it has been embedded.
I already tried to store it by breaking the text into several chunks enough small to fit into a cell (~32 000 chars), but it didn't work. After my macro had inserted the first 150 000 characters it gave me an "Out of Memory" error.
I remember seeing one web page with a couple of options for this I but cannot find it anymore. Any suggestions are most welcome. I will try them out if you are not sure if it works or not.
It would likely be best to simply save the .txt file alongside the Excel file, and have the macro pull the text as needed from that folder. To read more on importing files see this:
http://answers.microsoft.com/en-us/office/forum/office_2010-customize/vba-code-to-import-multiple-text-files-from/525bd388-0f7d-4b4a-89f9-310c67227458
Keeping the .txt within the Excel file itself is not necessary and will likely make it harder to transfer files in the long run. For example, if you cannot e-mail a file larger than 10MB, then you can simply break your .txt file in half and e-mail separately - using a macro which loads the text into Excel locally.
Very simple CustomXMLPart example:
Sub CustomTextTester()
Dim cxp1 As CustomXMLPart, cxp2 As CustomXMLPart
Dim txt As String
'read file content
txt = CreateObject("scripting.filesystemobject").opentextfile( _
"C:\_Stuff\test.txt").readall()
'Add a custom XML part with that content
Set cxp1 = ThisWorkbook.CustomXMLParts.Add("<myXMLPart><content><![CDATA[" & txt _
& "]]></content></myXMLPart>")
Debug.Print cxp1.SelectSingleNode("myXMLPart/content").FirstChild.NodeValue
End Sub
Consider the method shown below. It uses Caption property of Label object located on a worksheet for data storage. So you can create a number of such containers with different names.
Sub Test()
Dim sText
' create special hidden sheet for data storage
If Not IsSheetExists("storage") Then
With ThisWorkbook.Worksheets.Add()
.Name = "storage"
.Visible = xlVeryHidden
End With
End If
' create new OLE object TypeForms.Label type as container
AddContainer "test_container_"
' read text from file
sText = ReadTextFile("C:\Users\DELL\Desktop\tmp\tmp.txt", 0)
' put text into container
PutContent "test_container_", sText
' retrieve text from container
sText = GetContent("test_container_")
' show length
MsgBox Len(sText)
' remove container
RemoveContainer "test_container_"
End Sub
Function IsSheetExists(sSheetName)
Dim oSheet
For Each oSheet In ThisWorkbook.Sheets
If oSheet.Name = sSheetName Then
IsSheetExists = True
Exit Function
End If
Next
IsSheetExists = False
End Function
Sub AddContainer(sName)
With ThisWorkbook.Sheets("storage").OLEObjects.Add(ClassType:="Forms.Label.1")
.Visible = False
.Name = sName
End With
End Sub
Sub RemoveContainer(sName)
ThisWorkbook.Sheets("storage").OLEObjects.Item(sName).Delete
End Sub
Sub PutContent(sName, sContent)
ThisWorkbook.Sheets("storage").OLEObjects.Item(sName).Object.Caption = sContent
End Sub
Function GetContent(sName)
GetContent = ThisWorkbook.Sheets("storage").OLEObjects.Item(sName).Object.Caption
End Function
Function ReadTextFile(sPath, iFormat)
With CreateObject("Scripting.FileSystemObject").OpenTextFile(sPath, 1, False, iFormat)
ReadTextFile = ""
If Not .AtEndOfStream Then ReadTextFile = .ReadAll
.Close
End With
End Function
This is a question related to: Create text Files from every row in an Excel spreadsheet I have implemented ExactaBox great solution with the following code:
Sub SaveRowsAsENW()
Dim wb As Excel.Workbook, wbNew As Excel.Workbook
Dim wsSource As Excel.Worksheet, wsTemp As Excel.Worksheet
Dim r As Long, c As Long
Set wsSource = ThisWorkbook.Worksheets("worksheet1")
Application.DisplayAlerts = False 'will overwrite existing files without asking
r = 1
Do Until Len(Trim(wsSource.Cells(r, 1).Value)) = 0
ThisWorkbook.Worksheets.Add ThisWorkbook.Worksheets(1)
Set wsTemp = ThisWorkbook.Worksheets(1)
For c = 2 To 7
wsTemp.Cells((c - 1) * 2 - 1, 1).Value = wsSource.Cells(r, c).Value
Next c
wsTemp.Move
Set wbNew = ActiveWorkbook
Set wsTemp = wbNew.Worksheets(1)
'wbNew.SaveAs wsSource.Cells(r, 1).Value & ".csv", xlCSV 'old way
wbNew.SaveAs "textfile" & r & ".enw", xlCSV 'new way
'you can try other file formats listed at http://msdn.microsoft.com/en-us/library/office/aa194915(v=office.10).aspx
wbNew.Close
ThisWorkbook.Activate
r = r + 1
Loop
Application.DisplayAlerts = True
End Sub
Option Explicit
I have used this solution and it works fine. The only trouble I have is that some of the lines get quotation marks in the output file.
This is an example of output text file (line 2-3 demonstrates the error):
0 Journal Article 'No quotation marks
"%A Wofford, J.C."
"%A Goodwin, Vicki L."
%T A field study of a cognitive approach to understanding transformational and .. 'No quotation marks
This formatting seem to be added when it is being saved (it is not part of the cell formatting). Do any of you have any ideas of why this happens? /How can I adapt my code to fix it?
True. .csv stands for comma-separated values, where a field contains a comma it has to be 'escaped' (here with quotes) or would be split into different fields before/after each comma. Answer provided before does however offer alternatives - of which Tab delimited is the most logical.
This is likely past the point of being helpful to you, but after hitting this problem recently myself I thought I'd share my eventual solution. The formatting you're seeing is actually the result of a MS saving issue, which appends quotes to lines that have certain characters.
In my case I wrote out the file as usual and then called a sub that cleans the file of the problem extra characters. First I replaced any output that would need quotes with something like an asterisk or any other character that would never occur in my file. Then I saved the file as normal and called the below code, used to replace any character with another, twice. Once to remove the quotes Excel created, the second time to replace my dummy character with quotes. The code executes fairly quickly and renames the file so you can be certain the result is finished processing. Hopefully useful to others searching.
It's still clunkier than I'd like since you save a file and then edit it, but it worked well enough to become my final solution in the end.
Sub ReplaceStringInTextFile(FileNameAndLoc As String, OutFile As String, SearchForWords As String, SubstituteWords As String)
'This macro searches a file, replacing one string with another, saving it, and renaming it.
Dim objFSO As Object
Dim objReadFile As Object
Dim objWriteFile As Object
'Set Objects
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objReadFile = objFSO.opentextfile(FileNameAndLoc, 1, False)
'Read file contents
Contents = objReadFile.readall
'Close read file
objReadFile.Close
'Copy contents without double quotes
NewContents = Replace(Contents, SearchForWords, SubstituteWords)
'Write output
Set objWriteFile = objFSO.opentextfile(FileNameAndLoc, 2, False)
objWriteFile.write NewContents
objWriteFile.Close
'Rename file
Name FileNameAndLoc As OutFile
End Sub
I am looking to create a sort of Quiz using Powerpoint and I would like to save the input given by the user.
For example: If I ask the question: What is your favorite color? When they answer the question and click the next button, I would like to save the value of the textbox and append it to an output file.
I already know how to get the value and write the value to a file.
What I am looking to do is a sort of loop.
Here is the pseudo-code:
foreach(Control c in CurrentSlide.Controls)
{
File.Append(c.Value);
}
This way, no matter what controls are on the form, I want to save the value of each and every control.
Is this possible in VBA? If not, do you have any generic solutions for this situation?
Here's a more generic way of checking for each control on the slide, w/o knowing in advance how many there'll be. This assumes that you've kept the default names assigned to control shapes (TextBox1, CheckBox1 and so on). If you want to change those, you'll need to be sure that each TextBox has a name that includes at least one bit of string that's unique to it and change the code accordingly. Siddarth has already supplied code for writing to files and you said you have that under control so I'm just Debug.Printing the values here to keep the example simple.
Sub TestIt()
' Run this to test the shapes on slide 1
ProcessTheSlide ActivePresentation.Slides(1)
End Sub
Sub ProcessTheSlide(oSl As Slide)
Dim oSh As Shape
For Each oSh In oSl.Shapes
' Is it a control?
If oSh.Type = 12 Then ' msoOLEControlObject
On Error Resume Next
With oSh.OLEFormat.Object
If InStr(.Name, "TextBox") > 0 Then
Debug.Print .Text
End If
If InStr(.Name, "CheckBox") > 0 Then
Debug.Print .Value
End If
End With
End If
Next
End Sub
Is this possible in VBA?
Yes it is :)
On your presentation, Place 1 TextBox and two Command Buttons. Your presentation should look like this.
In the VBA Editor paste this code
Option Explicit
'~~> Save data to file
Private Sub CommandButton1_Click()
Dim filesize As Integer
Dim FlName As String
'~~> text File where you want to save the data
FlName = "C:\Sample.Txt"
'~~> Get a free file handle
filesize = FreeFile()
'~~> Open your file
Open FlName For Append As #filesize
'~~> Export Text
Print #filesize, TextBox1.Text
Close #filesize
TextBox1.Text = ""
End Sub
'~~> Exit Show
Private Sub CommandButton2_Click()
SlideShowWindows(1).View.Exit
End Sub
Now when you run it and click on "Next", the data will automatically be saved in the text file.
And this is how your text file will look...
HTH