When I "import" rtf data into word the format are not kept in the same way as when I open the rtf file.
I have a lot of rtf files and want them combined into word. When I use the code I have for csv files the format or the rtf file is missing.
'Define Source
On Error GoTo ErrorHandlerSourcePathIsEmpty
Set SourceContent = Documents.Open(SourceFolder & "\" & TestFile.RTF, Visible:=False)
On Error GoTo 0
'Insert source data into target.
'
On Error GoTo ErrorHandlerTargetBookmark1
wrdDoc.Bookmarks(TargetBookmark1).Range = SourceContent.Range.Text
Application.ScreenUpdating = True
On Error GoTo 0
Am I missing something like "format := SourceFormat" ???
The Text property never carries formatting information, only a string (characters).
There are two possible ways to insert formatted comment from another file into an opened document. Since it appears nothing should be done with the "source content" document there would be no need to open it. In that case, the first possibility (InsertFile method) would usually be preferred: needs fewer resources, faster in execution.
Use the InsertFile method:
Dim sourceContent as String
sourceContent = SourceFolder & "\" & TestFile.RTF
wrdDoc.Bookmarks(TargetBookmark1).Range.InsertFile sourceContent
Use the FormattedText property:
Unlike the Text property, FormattedText carries across formatting. The property needs to be set for both the target and source ranges.
Dim SourceContent as Word.Document
Set SourceContent = Documents.Open(SourceFolder & "\" & TestFile.RTF, Visible:=False)
wrdDoc.Bookmarks(TargetBookmark1).Range.FormattedText = SourceContent.Content.FormattedText
Related
Having trouble with vba editor. Have looked to many resources, and tried many proper unicodes for letter schwab "ə" and without dot "ı" but non of them displays correctly this letters. Tried to change font shrifts but it gives an error with russian letters. So I need both them displayed on editor as path and there is no way to change the path of folder.
I even tried character wide in vba of u+01DD, u+0259 like &H259,1DD but the result is or question mark or different character.
u+0131 gives an exact i with dot, not what I need.
Anyone knows how to display these characters in vba?
FolderName = "C...ə(?)lsheth/folders/"
FileName =Dir(FolderName & "*.xls*")
Do While FileName <> ""
Debug.Print FileName
FileName = Dir()
Loop
gives an error 52, Bad name or number
I think problems lay here that, there are many versions of schwa latin letter, and I need to use(try) all of them as I think the solution must be one of them. Does anyone know how to convert them to use in chrW() for VBA?
List is here; I have taken it from unicode page
0259 ə LATIN SMALL LETTER SCHWA • mid-central unrounded vowel • uppercase is 018F Ə • variant uppercase form 018E Ǝ is associated with 01DD ǝ → 01DD ǝ latin small letter turned e → 04D9 ә cyrillic small letter schwa
As already mentioned by #Toddleson, the Visual Basic Editor doesn't support Unicode characters. And the Dir function doesn't support it either. However, the FileSystemObject object does support it.
Here's an example that uses the ChrW function to return the desired unicode character, and then uses the FileSystembObject object to loop through each file within the specified folder, filter for .xls files, opens the file, and then saves and closes it.
Sub test()
Dim folderName As String
folderName = "C:\Users\Domenic\Desktop\D" & ChrW(&H259) & "nmark\" 'change the path accordingly
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim folder As Object
Set folder = fso.getfolder(folderName)
Dim file As Object
Dim wb As Workbook
For Each file In folder.Files
If InStr(1, file.Name, ".xls", vbTextCompare) > 0 Then
Set wb = Workbooks.Open(file.Path)
'etc
'
'
With wb
.Save
.Close
End With
End If
Next file
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
ChrW(399) = Ə
ChrW(305) = ı
These will not be displayed in VBE but when you assign the value into a cell, Excel will display these characters.
Alternatives:
ChrW(601) = ə
ChrW(618) = ɪ (it looks like the dotless i when printed in Calibri in Excel)
I am not a programmer so not sure what to do here. I would like an option of adding an image file in a Microsoft Word document userform for MAC. I had used a code earlier which works perfectly in Windows but it doesnt work for MAC and gives a 5948 error. I had added a field for the image in the userform with a button to add the image and the final submit button. The add button should allow the user to insert any size image from the local folder.
The code I was using is given below:
Dim ImagePath As String
Private Sub CMDAddImage_Click()
Dim objFileDialog As Office.FileDialog
Set objFileDialog = Application.FileDialog(MsoFileDialogType.msoFileDialogFilePicker)
With objFileDialog
.AllowMultiSelect = False
.ButtonName = "File Picker"
.Title = "File Picker"
If (.Show > 0) Then
End If
If (.SelectedItems.Count > 0) Then
Call MsgBox(.SelectedItems(1))
ImagePath = .SelectedItems(1)
End If
End With
Image1.Picture = LoadPicture(ImagePath)
End Sub
And the code in submit button was:
Dim objWord
Dim objDoc
Dim objShapes
Dim objSelection
'Set objSelection = ActiveDocument.Sections
'objSelection.TypeText (vbCrLf & "One Picture will be inserted here....")
ActiveDocument.Bookmarks("Field04").Select
Set objShapes = ActiveDocument.InlineShapes
objShapes.AddPicture (ImagePath)
End
End Sub
Can someone please help me edit the code for mac. In mac it does not allow to add the file.
You should check out the suggestion made by #JohnKorchok in a comment to your previous question - insert an image Content Control in your document instead, and throw away the VBA.
But if you need to keep using VBA and a UserForm...
Application.FileDialog is not available on Mac.
Application.GetOpenFileName is not avaialble from Word (it's an Excel thing).
Application.Dialogs does not do the same thing as GetOpenFileName so the user experience will be rather different, but at its simplest, you can use it like this:
With Application.Dialogs(wdDialogFileOpen)
' .Display = -1 for "OK" ("Open" in this case)
' .Display = 0 for "Cancel"
' (THere are other possible return values
' but I do not think they are applicable here)
If .Display = -1 Then
ImagePath = .Name
End If
End With
or if you prefer, the lengthier
Dim dlg As Word.Dialog
Set dlg = Application.Dialogs(wdDialogFileOpen)
With dlg
If .Display = -1 Then
ImagePath = .Name
End If
End With
Set dlg = Nothing
However, this dilaog does not let you specify file types or any kind of filtering, a starting folder etc. Attempts to set Finder search criteria via something like
.Name = "(_kMDItemFileName = ""*.jpg"")"
.Update
before the .Display either can't work or need different syntax.
Further, the Apple dialog may start with its
own filtering set up so the user will have to click Options to enable All Files. You don't know what file type the user will choose so you will need to deal with that.
An alternative is to invoke Applescript. For this, it appears that you can still use the VBA MacScript command, which means that you can put all the script in your VBA file. If that does not work, then unfortunately you have to use AppleScriptTask which would require you to work some more on the Script and install the script in the correct folder on every Mac where you need this feature.
Here's the code I used - you would probably need to wrap everything up in another function call and use conditional compilation or other tests to call the correct routine depending on whether the code is running on Mac or Windows
Private Sub CMDAddImage_Click()
Dim s As String
Dim sFileName As String
On Error Resume Next
s = ""
' set this to some other location as appropriate
s = s & "set thePictureFoldersPath to (path to pictures folder)" & vbNewLine
s = s & "set applescript's text item delimiters to "",""" & vbNewLine
s = s & "set theFile to ¬" & vbNewLine
' add the image file types you want here
s = s & "(choose file of type {""png"",""jpg""} ¬" & vbNewLine
s = s & "with prompt ""Choose an image to insert."" ¬" & vbNewLine
s = s & "default location alias thePictureFoldersPath ¬" & vbNewLine
s = s & "multiple selections allowed false) as string" & vbNewLine
s = s & "set applescript's text item delimiters to """"" & vbNewLine
' choose file gives as an AFS path name (with colon delimiters)
' get one Word 2016/2019 will work with
s = s & "posix path of theFile"
sFileName = MacScript(s)
If sFileName <> "" Then
' Maybe do some more validation here
ImagePath = sFileName
Image1.Picture = LoadPicture(ImagePath)
End If
End Sub
I have a longer code and in the final part there is an ActiveX button for saving and closing the file. Also, for efficiency, I've added an vbYesNo command for creating a new document based on the template in use.
The code:
Sub macrosave ()
Dim doc As Document
Dim strDosar As String
Dim Ret As Variant
Set doc = Application.ActiveDocument
strDosar = Range.Paragraphs(1).Range.Text
Ret = MsgBox("Do you want to create a new document?", vbYesNo)
If Ret = vbYes Then
Documents.Add Template:=ActiveDocument.AttachedTemplate.Path & Application.PathSeparator & ActiveDocument.AttachedTemplate.Name
End If
doc.SaveAs "\\server\Public\" & strDosar & ".doc", FileFormat:=wdFormatDocument = 0
doc.Close
End Sub
If I click yes, a new document is created, the last one is saved and closed afterwards.
If I click no, the active document is saved, but it is not closed afterwards.
I suspect it has something to do with the file format (wdFormatDocument) because this way it eliminates all VBA codes.
The file format is needed because I want to get rid of all content controls after saving the file.
Why doc.Close is not being executed in the second case and what are my options in order to achieve the purpose?
This argument is invalid:
FileFormat:=wdFormatDocument = 0
Perhaps:
Sub macrosave()
Dim doc As Document, strDosar As String, Ret As Variant
Set doc = ActiveDocument
strDosar = Split(doc.Range.Paragraphs(1).Range.Text, vbCr)(0)
Ret = MsgBox("Do you want to create a new document?", vbYesNo)
If Ret = vbYes Then Documents.Add Template:=doc.AttachedTemplate.FullName
doc.SaveAs "\\server\Public\" & strDosar & ".doc", FileFormat:=wdFormatDocument
doc.Close False
End Sub
I believe the problem comes from a disagreement between the file extension - doc and the specified file format wdFormatDocument.
Starting with Word 2007 the default file format (wdFormatDocument) refers to the Word Open XML file format, docx. To save as the doc file format requires using wdFormatDocument97. The reason it may have intermittently worked is because the numerical value of this enumeration is 0.
Try
doc.SaveAs "\\server\Public\" & strDosar & ".doc", FileFormat:=wdFormatDocument97
Or change the extension to docx
doc.SaveAs "\\server\Public\" & strDosar & ".docx", FileFormat:=wdFormatDocument
However docx will not remove the content controls the next time the document is opened. (The doc format will because content controls were introduced at the same time as the new file format, so they aren't supported in the old format.)
If the additional purpose is " it eliminates all VBA codes" then it would make sense to change the attached template before closing the document to Normal.dotm. This removes the link to the attached template and has the added advantage that the document will "find" its template no matter who opens it, later. (When the attached template is not present it can delay opening by a considerable time under some circumstances.)
doc.AttachedTemplate = NormalTemplate
Note that it will also make things simpler to pick up the file path using the FullName poperty of the template:
Documents.Add Template:=ActiveDocument.AttachedTemplate.FullName
So, I'm using the output from a record set and writing out to a csv file. But I'm getting an issue with Quotation marks. Ideally I'd like to include them as text markers. But if I include them in my line of text they get printed as two sets of quotation marks.
I want this as the output (delimited by tabs):
"Header1" "header2" "......[]...."headerX"
I tried this
Sub Write_Tbl(Filename, StrSQL)
Dim unicode, UTF, i As Long , Fileout As Object, forwriting, TristateUseDefault, TxtStr As String, TextHolder As String, rs As Recordset
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim File_out As Object
Set File_out = fso.CreateTextFile(Filename, True, unicode = UTF - 8)
File_out.Close
Open Filename For Output As #1
Set rs = CurrentDb.OpenRecordset(StrSQL)
rs.MoveFirst
'for headers
TxtStr = rs.Fields.Item(0).Name 'so that there isn't a tab at the start of the string
For i = 1 To rs.Fields.Count - 1
TxtStr = TxtStr & chr(34) & vbTab & chr(34) & rs.Fields.Item(i).Name
Next i
Write #1, TxtStr & chr(34) 'write headers to file
and got this as the output
""Header1"" ""header2"" ""......[]....""headerX""
So I removed the quotation marks and got this:
'for headers
TxtStr = rs.Fields.Item(0).Name 'so that there isn't a tab at the start of the string
For i = 1 To rs.Fields.Count - 1
TxtStr = TxtStr & vbTab & rs.Fields.Item(i).Name
Next i
Write #1, TxtStr 'write headers to file
and what I'm getting is
"Header1 header2 ......[]....headerX"
If I monitor the variables in the locals window, there's only one set of quotes so it must be something to do with printing? It doesn't happen if I use single quotation marks (ascii no 39). I also tried just using write to file, rather than as a text stream, but I got memory issues and ERROR 5 issues. STUMPED. Please help.
If you have prepared your text string in VBA, you should use the Print # statement instead of Write # .
Documentation: Print # vs. Write #
Unlike the Print # statement, the Write # statement inserts commas between items and quotation marks around strings as they are written to the file.
Note:
I'm not sure if these functions write Unicode at all, or care how the file was created.
Open Filename For Output As #1
will create the file if it doesn't exist, so you can probably omit the whole CreateTextFile part.
Or use File_out.WriteLine() instead, it seems odd to mix both methods (FSO and the ancient Print/Write statements).
Edit: see How to create and write to a txt file using VBA
I need to add text string to all files on a folder, as a footer
For example, on the folder on the path and called C:\mobatchscripts\
I have a random number of txt files, with text.
I want to add a line for example "text" on each of the text files on the folder
I have little knowledge of vba programming, but for what I have read I can use append, but I need something that loop on the files on the folder, and modify them.
So far I tried this:
Sub footer()
Dim FolderPath As String
Dim FileName As String
Dim wb As Excel.Workbook
FolderPath = "C:\mobatchscripts\"
FileName = Dir(FolderPath)
Do While FileName <> ""
Open FileName For Append As #1
Print #1, "test"
Close #1
FileName = Dir
Loop
End Sub
But seems that its not looking into the files, or appending the text.
On the assumption that you're writing to text files (I see "batchscripts" in the path), you need a reference to the Microsoft Scripting Runtime (Within the VBE you'll find it in Tools, References)
Option Explicit
Public Sub AppendTextToFiles(strFolderPath As String, _
strAppendText As String, _
blnAddLine As Boolean)
Dim objFSO As FileSystemObject
Dim fldOutput As Folder
Dim filCurrent As File
Dim txsOutput As TextStream
Set objFSO = New FileSystemObject
If objFSO.FolderExists(strFolderPath) Then
Set fldOutput = objFSO.GetFolder(strFolderPath)
For Each filCurrent In fldOutput.Files
Set txsOutput = filCurrent.OpenAsTextStream(ForAppending)
If blnAddLine Then
txsOutput.WriteLine strAppendText
Else
txsOutput.Write strAppendText
End If
txsOutput.Close
Next
MsgBox "Wrote text to " & fldOutput.Files.Count & " files", vbInformation
Else
MsgBox "Path not found", vbExclamation, "Invalid path"
End If
End Sub
I'd recommend adding error handling as well and possibly a check for the file extension to ensure that you're writing only to those files that you want to.
To add a line it would be called like this:
AppendTextToFiles "C:\mobatchscripts", "Test", True
To just add text to the file - no new line:
AppendTextToFiles "C:\mobatchscripts", "Test", False
Alternatively, forget the params and convert them to constants at the beginning of the proc. Next time I'd recommend working on the wording of your question as it's not really very clear what you're trying to achieve.