Hello Dear StackOverFlowers,
My question may be trival but I'm currently out of option to think of after searching all afternoon
Context: I have a excel worksheet with 120 rows or so that I need to use to create files with.
Data is structured as follow:
The A column contains destination file names
B column has the corresponding data that needsto be written in each file
Giving us the following general layout
data file layout
So, to get data from B column written in each A column named files, I wrote the followin VBScript snippet:
Option Explicit
Sub writeExportedMsgToXML()
' wrote that tiny script not to have to copy pate 117 messages by hand to have ops put them back on Q
Dim currentRow As Integer
' modify to match your data row start and end
For currentRow = 2 To 11
Dim messageID As String
Dim messageitSelf As String
messageID = Trim(ActiveSheet.Range("A" & currentRow))
messageitSelf = ActiveSheet.Range("B" & currentRow)
Dim subDirectory As String
subDirectory = "xmls"
Dim filePath As String
filePath = ActiveWorkbook.Path & "\" & subDirectory & "\" & messageID & ".xml"
MsgBox (messageitSelf) ' for test purpose
Open filePath For Output As #1
Write #1, messageitSelf
Close #1
Next currentRow
End Sub
The script does mostly what it's intended for Except , and this is the source of my question today, it enclose the file content between double quotes as you can see below:
file content enclosed in double quotes
So, in a case where a file named F1.xml should just contain <foo><bar>Baz</bar></foo>
My script transform it as "<foo><bar>Baz</bar></foo>"
What I tried
Replacing file writing part with the following
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "UTF-8"
Dim subDirectory As String
subDirectory = "xmls"
Dim filePath As String
filePath = ActiveWorkbook.Path & "\" & subDirectory & "\" & messageID & ".xml"
objStream.Open
objStream.WriteText messageitSelf
objStream.SaveToFile filePath
objStream.Close
With same outcome
Any clues on what I'm missing/Doing wrong ?
Should I declare messageitSelf as a different type ?
Any help would be appreciated :)
Thank you
Write# statements surround strings with double quotes:
Unlike the Print # statement, the Write # statement inserts commas between items and quotation marks around strings as they are written to the file.
Use Print# instead:
Dim fn As Long
fn = VBA.FreeFile
Open filePath For Output As #fn
Print #fn, messageitSelf
Close #fn
Related
My macro will need to read through a very large directory of files and parse data from them. This directory is updated periodically so I am trying to optimize my program to only read files that were added since the last time the program was run.
So far using FileSystemObject it seems I can only read files alphabetically, if I'm not mistaken.
The best solution I have so far is to read all the files every time, create an array containing the file information, sort by DateModified, then open only the files I need. I'm curious to see if I can skip this step by reading files in order of DateModified.
Thanks in advance.
Shell does seem to be a good option here - although I haven't compared performance against a FSO. You could, for example, consider the forfiles command which allows you to retrieve files modified after a specified date?
Some sample code for that would be as follows:
Public Sub RunMe()
Dim fileNames As Collection
Dim path As String
Dim dat As Date
Dim file As Variant
'Set the path and 'find after' date.
path = "c:\user\documents"
dat = #1/1/2018#
'Fetch the files, setting mask as required.
'This example is fetching all .txt files.
Set fileNames = GetFilesModifiedAfter(path, dat, "*.txt")
'Process the list of files.
If Not fileNames Is Nothing Then
For Each file In fileNames
' ... do stuff here.
Debug.Print path & "\" & file
Next
End If
End Sub
Private Function GetFilesModifiedAfter( _
path As String, _
after As Date, _
Optional mask As String) As Collection
Dim cmd As String
Dim piped() As String
Dim result As Collection
Dim i As Long
'Build the command string.
'Date must be formatted as MM/DD/YYYY.
cmd = "cmd.exe /s /c forfiles /p " & _
"""" & path & """" & _
" /d +" & Format(after, "mm/dd/yyyy")
'Add the mask if passed-in.
If mask <> vbNullString Then cmd = cmd & " /m " & mask
'Execute the command and split by /r/n.
piped = Split(CreateObject("WScript.Shell").Exec(cmd).StdOut.ReadAll, vbCrLf)
'Leave if nothing is returned.
If UBound(piped) = -1 Then Exit Function
'Poplate the result collection,
'and remove the leading and trailing inverted commas.
Set result = New Collection
For i = 0 To UBound(piped)
If Len(piped(i)) > 2 Then
result.Add Mid(piped(i), 2, Len(piped(i)) - 2)
End If
Next
'Return the result collection.
Set GetFilesModifiedAfter = result
End Function
Update
I've just done some testing and it seems FSO is quicker, certainly on Folders containing fewer than 100 files. It'd be interesting to run this on really large folders (say a thousand files) as instinctively I feel Shell might have a performance advantage. However, for now, here's the FSO version:
Private Function GetFilesModifiedAfter2( _
path As String, _
after As Date, _
mask As String) As Collection
Dim fso As Object, file As Object
Dim result As Collection
'Instance of objects.
Set fso = CreateObject("Scripting.FileSystemObject")
Set result = New Collection
'Iterate the files and test date last modified property.
For Each file In fso.GetFolder(path & "\").Files
If file.Name Like mask And file.DateLastModified > after Then
result.Add file.Name
End If
Next
'Return the result collection.
Set GetFilesModifiedAfter2 = result
End Function
I'm very new to VBA in Excel. I'm using this code I cobbled together from example snippets online to convert a column of cells in Excel to a text file:
Private Sub CommandButton1_Click()
Dim myFile As String, rng As Range, cellValue As Variant, i As Integer, j As Integer
Dim FName As String
Dim FPath As String
Set fsT = CreateObject("ADODB.Stream"): 'Create Stream object
fsT.Type = 2: 'Specify stream type – we want To save text/string data.
fsT.Charset = "utf-8": 'Specify charset For the source text data.
FPath = "C:\WHIT\ParamGen"
FName = Sheets("Sheet1").Range("b49").Text
myFile = FPath & "\" & FName
Set rng = Range("B2: B42 ")
Open myFile For Output As #1
For i = 1 To rng.Rows.Count
For j = 1 To rng.Columns.Count
cellValue = rng.Cells(i, j).Value
If j = rng.Columns.Count Then
Print #1, cellValue
Else
Print #1, cellValue,
End If
Next j
Next i
Close #1
End Sub
The problem is that the first cell in my Excel file contains this text:
#!=1
...and it shows up in the generated text file like this:
?#!=1
Everything else in the excel file gets written to the text file without issue, but that question mark messes up the import function in the software this file is being generated for.
Any ideas on getting this question mark to disappear?
Have you tried removing the "?" with code in the file, such as:
If left(cellvalue,1)="?" then
application.substitute(cellvalue,"?","")
end if
I ran this code with the first cell containing #!=1 and it wrote correctly to the text file as #!=1 (no ? added). Did you check to see if cell B2 contains any non-printable characters?
I found a solution. Excel was treating the #!=1 in the first cell as a function, but it wasn't a functional function. My best guess is that it was throwing an invisible character in there as it parsed it into a text file. Overwriting the offending cell with '#!=1 did the trick.
I am a technical writer and not much of a coder, I have thousands of .xml files that combined create a book. I used a VBA script from this website to rename all of the files to fit within the new guidelines, now I need to go into the xml code and find all references to those links and replace them with the new file name.
I have an excel spreadsheet where in column A it has the old file name and in column B it has the new file name.
The tag looks like this:
<?iads.link docref="R381"?>
It needs to find "R381" in column A and replace it with "R01081-1-1520-237", the file name in the adjacent cell in column B.
The Tag needs to look like this:
<?iads.link docref="R01081-1-1520-237"?>
I tried using the code from the question How can I Find/Replace multiple strings in an xml file? but it did not work and I'm not even sure if that's the correct question to be asking
My current code looks lie this:
Option Explicit ' Use this !
Public Sub ReplaceXML(rFindReplaceRange As Range) ' Pass in the find-replace range
Dim sBuf As String
Dim sTemp As String
Dim iFileNum As Integer
Dim sFileName As String
Dim i As Long
' Edit as needed
sFileName = "C:\Users\s37739\Desktop\chap3"
iFileNum = FreeFile
Open sFileName For Input As iFileNum
Do Until EOF(iFileNum)
Line Input #iFileNum, sBuf
sTemp = sTemp & sBuf & vbCrLf
Loop
Close iFileNum
' Loop over the replacements
For i = 1 To rFindReplaceRange.Rows.Count
If rFindReplaceRange.Cells(i, 1) <> "" Then
sTemp = Replace(sTemp, rFindReplaceRange.Cells(i, 1), rFindReplaceRange(i, 2))
End If
Next i
' Save file
iFileNum = FreeFile
' Alter sFileName first to save to a different file e.g.
sFileName = "C:\Users\s37739\Desktop\chap3"
Open sFileName For Output As iFileNum
Print #iFileNum, sTemp
Close iFileNum
End Sub
Sub mike1()
End Sub
You are passing the file path when in fact you should be passing the fully qualified file name (file path and file name).
You need to edit those lines
' Edit as needed
sFileName = "C:\Users\s37739\Desktop\chap3"
'...
' Alter sFileName first to save to a different file e.g.
sFileName = "C:\Users\s37739\Desktop\chap3"
With
' Edit as needed
sFileName = "C:\Users\s37739\Desktop\chap3\yourfilename.xml"
'...
' Alter sFileName first to save to a different file e.g.
sFileName = "C:\Users\s37739\Desktop\chap3\yourNEWfilename.xml"
Also, remember to provide the correct Range when running the procedure.
Supposing your Range goes from "A1:B50" you can edit your mike1 sub as follows:
Sub mike1()
' Change range as desired
Call ReplaceXML(ThisWorkbook.Worksheets("YourSheetName").Range("A1:B50"))
End Sub
After that, all you need to do is run mike1 from the Immediate window.
Access using Alt+F11 for the VBA editor then View -> Immediate.
You should see a new window at the bottom of the screen. Just type mike1 in there and hit Enter
UPDATE:
Ideally, you should first try to understand the code you currently have and change it make it work on multiple files instead of a single one per run. There are many places around that can give you examples on how to do that, either recursively or in a loop directly into a function. There are many ways to do it and also many material around it.
That being said, you can find below one of the many approaches to solve your issue. The following code consists of two Subs that you can copy/paste into your module.
You need to change the value of HOST_PATH with the main folder and the findReplaceRange with the range to work with. You need to change "Sheet1" with the name of your worksheet and the "A1:B10" with your actual range. After that, just run the ReplaceXML2() Sub.
Note: this will update ALL XML files under the folder provided, so make sure you gave it enough testing (preferably, backup your files) before running it for the entire folder. If you have further issues I suggest asking another question.
Code:
Public Sub ReplaceXML2()
Const HOST_PATH = "C:\Users\s37739\Desktop\chap3\" ' change accordingly
Dim findReplaceRange As Range
Set findReplaceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:B10") ' change accordingly
Dim FileSystem As Object
Set FileSystem = CreateObject("Scripting.FileSystemObject")
Call RecursivelyReplaceXML(FileSystem.GetFolder(HOST_PATH), findReplaceRange)
End Sub
Public Sub RecursivelyReplaceXML(parentFolder, rFindReplaceRange As Range) ' Pass in the folder and the find-replace range
Dim subFolder As Object
For Each subFolder In parentFolder.SubFolders
RecursivelyReplaceXML subFolder, rFindReplaceRange
Next
Dim file As Object
For Each file In parentFolder.Files
If Right(file.Name, 4) = ".xml" Then
Dim iFileNum As Integer
Dim sTemp As String
Dim sBuf As String
Dim i As Long
Dim fullFileName As String
fullFileName = file.Path
iFileNum = FreeFile
Open fullFileName For Input As iFileNum
sTemp = "" ' clean up to read the next file
Do Until EOF(iFileNum)
Line Input #iFileNum, sBuf
sTemp = sTemp & sBuf & vbCrLf
Loop
Close iFileNum
' Loop over the replacements
For i = 1 To rFindReplaceRange.Rows.count
If rFindReplaceRange.Cells(i, 1) <> "" Then
sTemp = Replace(sTemp, rFindReplaceRange.Cells(i, 1), rFindReplaceRange(i, 2))
End If
Next i
' Save file
iFileNum = FreeFile
' WARNING: New name definition commented out,
' which means all files will be replaced with newer versions!!
'===
' Alter fullFileName first to save to a different file e.g.
' fullFileName = "C:\Users\s37739\Desktop\chap3\"
Open fullFileName For Output As iFileNum
Print #iFileNum, sTemp
Close iFileNum
End If
Next
End Sub
Currently i using VBA code to export range data to a CSV file:
Sub Fct_Export_CSV_Migration() Dim Value As String Dim size As Integer
Value = ThisWorkbook.Path & "\Export_Migration" & Sheets(1).range("B20").Value & ".csv" chemincsv = Value
Worksheets("Correspondance Nv Arborescence").Select Dim Plage As Object, oL As Object, oC As Object, Tmp As String, Sep$ Sep = ";" size = Worksheets("Correspondance Nv Arborescence").range("B" & Rows.Count).End(xlUp).Row Set Plage = ActiveSheet.range("A1:B" & size)
Open chemincsv For Output As #1 For Each oL In Plage.Rows
Tmp = ""
For Each oC In oL.Cells
Tmp = Tmp & CStr(oC.Text) & Sep
Next
'take one less than length of the string number of characters from left, that would eliminate the trailing semicolon
Tmp = Left(Tmp, Len(Tmp) - 1)
Print #1, Tmp Next Close
MsgBox "OK! Export to " & Value End Sub
Now, i would like to export CSV encoded with "Unicode". I think i need to use VBA function like SaveAs( xlUnicodeText ) but how to use that ?
Thx
Unicode CSVs are not one of the file formats supported by Excel, out of the box. This means we cannot use the SaveAs method. The good news we can work around this restriction, using VBA.
My approach uses the file system object. This incredibly handy object is great for interacting with the file system. Before you can use it you will need to add a reference:
From the VBA IDE click Tools.
Click References...
Select Windows Script Host Object Model from the list.
Press OK.
The code:
' Saves the active sheet as a Unicode CSV.
Sub SaveAsUnicodeCSV()
Dim fso As FileSystemObject ' Provides access to the file system.
Dim ts As TextStream ' Writes to your text file.
Dim r As Range ' Used to loop over all used rows.
Dim c As Range ' Used to loop over all used columns.
' Use the file system object to write to the file system.
' WARNING: This code will overwrite any existing file with the same name.
Set fso = New FileSystemObject
Set ts = fso.CreateTextFile("!!YOUR FILE PATH HERE.CSV!!", True, True)
' Read each used row.
For Each r In ActiveSheet.UsedRange.Rows
' Read each used column.
For Each c In r.Cells
' Write content to file.
ts.Write c.Value
If c.Column < r.Columns.Count Then ts.Write ","
Next
' Add a line break, between rows.
If r.Row < ActiveSheet.UsedRange.Count Then ts.Write vbCrLf
Next
' Close the file.
ts.Close
' Release object variables before they leave scope, to reclaim memory and avoid leaks.
Set ts = Nothing
Set fso = Nothing
End Sub
This code loops over each used row in the active worksheet. Within each row, it loops over every column in use. The contents of each cell is appended to your text file. At the end of each row, a line break is added.
To use; simply replace !!YOUR FILE PATH HERE.CSV!! with your file name.
I have the following code where I am trying to modify some Txt files in a specific folder. I first want to check that the Loop works. However when I run the macro the code can only read the first file and then there is a runtime 5 error at strFileName = Dir(). I am not sure what the problem is. The only issue I can think of is that I am moving the code between two module sheets. The folder location is being saved in a txt box in Sheet 1 of an excel workbook.
Sub Txt_File_Loop()
Public TextFile As String
Dim FolderLocation As String
Dim strFielName As String
Dim SaveLocation As String
'Location is present in a Text box
FolderLocation = Sheets(1).FolderLocationTXTBX.Text
strFileName = Dir(FolderLocation & " \ * ")
Do Until strFileName = ""
TextFile = FolderLocation & "\" & strFileName
Module2.Macro1
strFileName = Dir() 'ERROR is Here
Loop
End Sub
Sub Macro1()
Dim x As String
Open TextFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
x = x & textline
Loop
Close #1
MsgBox x
End Sub
Have a look at these modifications. They seem to correct several things and run through well.
Option Explicit
Sub Txt_File_Loop()
Dim FolderLocation As String
Dim strFileName As String
Dim SaveLocation As String
'Location is present in a Text box
FolderLocation = Sheets(1).FolderLocationTXTBX.Text 'Environ("TMP")
strFileName = Dir(FolderLocation & "\*.txt")
Do Until strFileName = ""
Debug.Print FolderLocation & "\" & strFileName
Module2.Macro1 FolderLocation & "\" & strFileName
strFileName = Dir() 'ERROR is Here
Loop
End Sub
Sub Macro1(sFPFN As String)
Dim x As String, textline As String
Debug.Print sFPFN
Open sFPFN For Input As #1
Do Until EOF(1)
Line Input #1, textline
x = x & textline
Loop
Close #1
MsgBox x
End Sub
I passed the folder and filename name across as a string-type parameter. Also, I don't know why you had the extra spaces in (FolderLocation & " \ * " ; I tightened that up. There were a few misspellings and undeclared variables; these can be avoided with Option Explicit¹ at the top of the module code sheet. Get into the practise of standard indentation with your code. It certainly improves readability if nothing else.
¹ Setting Require Variable Declaration within the VBE's Tools ► Options ► Editor property page will put the Option Explicit statement at the top of each newly created code sheet. This will avoid silly coding mistakes like misspellings as well as influencing you to use the correct variable type in the variable declaration. Variables created on-the-fly without declaration are all of the variant/object type. Using Option Explicit is widely considered 'best practice'.