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)
Related
I need to delete all the files in the folder.
The code runs well when file names consist of the latin letters.
It returns runtime error 52 (Bad file name or number) when any of the files contain cyrillic letters.
Surprisingly, it worked well even with cyrillic letters on my old PC.
Sub Kill1()
Dim aFile As String
aFile = "C:\Users\belose\Downloads\temp\*.*"
If Len(Dir$(aFile)) > 0 Then
Kill aFile
End If
End Sub
What could be the matter?
Solution
As per the comment from the OP, the solution was to change the regional settings...
Settings->Time and language->Addditional date time settings->Change location and chose Russia
The Dir function does not support Unicode characters. Try using the FileSystemObject instead.
The following example loops through each file in the specified folder, and then deletes any file that contains one of the specified file extensions.
Change the path to the source folder accordingly. Also, add and/or change the file extensions as desired.
Option Explicit
Sub DeleteFiles()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim sourceFolder As Object
Set sourceFolder = fso.GetFolder("c:\users\domenic\desktop") 'change the path accordingly
Dim currentFile As Object
For Each currentFile In sourceFolder.Files
Select Case fso.GetExtensionName(currentFile)
Case "txt", "csv", "xlsx", "xlsm" 'add and/or change the file extensions as desired
fso.DeleteFile currentFile.Path
End Select
Next currentFile
Set currentFile = Nothing
Set sourceFolder = Nothing
Set fso = Nothing
End Sub
I found the root cause. I have Win 10. I went to the Settings->Time and language->Addditional date time settings->Change location and chose Russia. Before I had just a similar issue with python and then I felt that it'snot the problem of the code.
The goal of my effort is to have a VBA macro that will consolidate a number of PPT presentations into a single PPT presentation. The component presentations that are to be combined are in a number of locations. This seems to be a crucial factor. I found a very good 'almost' solution, but it was based on all of the component presentations being in a single folder. I was able to modify the example, but ActivePresentation.Slides.InsertFromFile will only function if the path to a component presentation is hardcoded. I need this to be data-driven. When I try to reference a variable containing the path, ActivePresentation.Slides.InsertFromFile fails with the error "Error inserting files Error: -2147483640 Powerpoint could not open the file".
Any assistance to get this running by passing the component path as a variable would be very appreciated. Thanks, Jack
The contents of the MANIFEST.txt file are the two lines:
topic-1/control-structures.pptm
topic-2/cursors.pptm
Sub InsertExample()
' Inserts all presentations named in MANIFEST.txt into current presentation in list order
' MANIFEST.txt must be properly formatted, one full path name per line
On Error GoTo ErrorHandler
Dim ManifestFileName As String
Dim ManifestFilePathColons As String
Dim ManifestFilePathSlashes As String
Dim iListFileNum As Integer
Dim ManifestPresentationName As String
Dim FullPresentationPath As String
' name of file containing files to be inserted
ManifestFileName = "MANIFEST.txt"
' use the path with colons to work with the MANIFEST.txt file
ManifestFilePathColons = "Macintosh HD:Users:freejak:Google Drive:stirling:course-topics:auto-consolidate:"
' use the path with slashes to work with the ActivePresentation.Slides.InsertFromFile PPT method
ManifestFilePathSlashes = "Macintosh HD/Users/freejak/Google Drive/stirling/course-topics/auto-consolidate/"
' Do we have a file open already?
' Debug.Print Presentations.Count
If Not Presentations.Count > 0 Then
Exit Sub
End If
iListFileNum = FreeFile()
Open ManifestFilePathColons & ManifestFileName For Input As iListFileNum
' Process the list
While Not EOF(iListFileNum)
' Get a line from the list file
Line Input #iListFileNum, ManifestPresentationName
'The following invocation works, and the seperator must be a slash
Call ActivePresentation.Slides.InsertFromFile("Macintosh HD/Users/freejak/Google Drive/stirling/course-topics/auto-consolidate/topic-1/control-structures.pptm", _
ActivePresentation.Slides.Count)
FullPresentationPath = ManifestFilePathSlashes & ManifestPresentationName
'This invocation fails, the same error occurs if I call passing "ManifestFilePathSlashes & ManifestPresentationName" without the quotes
' This fails whether the seperators are colons or slashes
' Call ActivePresentation.Slides.InsertFromFile(FullPresentationPath, ActivePresentation.Slides.Count)
Wend
Close #iListFileNum
MsgBox "DONE!"
NormalExit:
Exit Sub
Not sure if this is relevant but you’ve got an extra “topic1” subfolder when you type the path out, vs the path written into the string variables.
I am having trouble coding this VBA Macro for a bunch of CSV files (10000). After searching I found/used this for my code:
Loop through files in a folder using VBA? . It doesn't seem to work and I'm not sure why... I have tried the While loop but it is very slow I don't know if it can finish running.
Sub LoopThroughFiles()
Dim MyObj As Object, MySource As Object, file As Variant
file = Dir("C:\Users\me\Desktop\test")
While (file <> "")
If InStr(file, "test") > 0 Then
'// my macro code is here
Exit Sub
End If
file = Dir
Wend
End Sub
What else should I try changing? Where did I go wrong? I have also tried using this code https://www.thespreadsheetguru.com/the-code-vault/2014/4/23/loop-through-all-excel-files-in-a-given-folder but am unsure what else to change besides the directory and the 'Change First Worksheet's Background Fill Blue.
Also tried this http://www.ozgrid.com/VBA/loop-through.htm which seems pretty fool proof but I cant get it to work...
UPDATES FROM L8N
Option Explicit
Sub looper()
Dim fso As Scripting.FileSystemObject
Dim aFolder As Scripting.Folder
Dim aFile As Scripting.file
Dim aText As Scripting.TextStreame
Dim singleLine As String
Set fso = New FileSystemObject
Set aFolder = fso.GetFolder("C:\Users\ME\Desktop\test") 'set path to the folder that contains the files
For Each aFile In aFolder.Files 'loops through every file in the top level of the folder
If InStr(1, vbBinaryCompare) > 0 Then
Range("A2:D200210").Clear 'what i want to happen to every file
Set aText = fso.OpenTextFile(aFile.Path, ForReading)
Do Until aText.AtEndOfStream
singleLine = aText.ReadLine 'read line into string, every call advances the line counter by one, this prevents skipping lines
If InStr(1, singleLine, vbBinaryCompare) > 0 Then Debug.Print singleLine ' in line case, prints line if target value is found
Loop
End If
Next aFile
Debug.Print "finished"
End Sub
It runs, but it does not seem to implement the changes I want (Range("A2:D200210").Clear ) to each file. Also the string name for my code does not matter, the info in the sheet does not either. My original code was to test if it looped at all.
I don't know exactly what you are trying to do, the code you have does the following:
file = Dir("C:\Users\me\Desktop\test") writes the filename to file if the file "test" exists, if you use Dir("C:\Users\me\Desktop\test\") the function will return the name of the first file it finds.
On subsequent runs it will return the next file in the folder, keep in mind that this is a global call, so if you call the function somewhere else it may interfere. Using the Microsoft Scripting Engine Runtime is preferable in most cases apart from quick checks if a file exists.
If InStr(file, "test") > 0 Then You test if "test" is a part of the filename, so far so good, but keep in mind to tell InStr how it should compare the two strings. InStr accepts four parameters (all of them optional), be sure to pass the proper ones. The microsoft documentation is actually quite decent.
Is this what you wanted? I think you might be looking for something inside the .csv file, if so I can extend the script below.
A simple way to loop though all files in a folder is attached below:
Option Explicit
Sub looper()
Dim fso As Scripting.FileSystemObject
Dim aFolder As Scripting.Folder
Dim aFile As Scripting.file
Dim aText As Scripting.TextStream
Dim targetName As String 'string that identifies files
Dim targetWord As String 'string that identifies line inside csv file
Dim singleLine As String
Set fso = New FileSystemObject
Set aFolder = fso.GetFolder("C:\Users\Me\Desktop\test") 'set folder that contains the files
targetName = "someFileName"
targetWord = "someString"
For Each aFile In aFolder.Files 'loops through every file in the top level of the folder
If InStr(1, aFile.Name, targetName, vbBinaryCompare) > 0 Then
Debug.Print "Found a matching File: "; aFile.Name
Set aText = fso.OpenTextFile(aFile.Path, ForReading)
Do Until aText.AtEndOfStream
singleLine = aText.ReadLine 'read line into string, every call advances the line counter by one, this prevents skipping lines
If InStr(1, singleLine, targetWord, vbBinaryCompare) > 0 Then Debug.Print singleLine ' in line case, prints line if targer value is found
Loop
End If
Next aFile
Debug.Print "finished"
End Sub
Bonus Info:
Use option explicit to make sure all variables are declared properly
Edit:
Not able to add comments to your post yet, so I'll put the response here.
If InStr(1, vbBinaryCompare) > 0 Then this line is now broken as it will always return 0. If you want to loop through every file just omit the IF-Contitional or set it to If True Then.
Range("A2:D200210").Clear is a so called implicit reference, the Range Object refers to the "Global" Worksheet. Every time this piece of code is executed, the change happens on the "Global" Worksheet, a nice answer by Mathieu Guindon from just recently explains this.
It runs, but it does not seem to implement the changes I want (Range("A2:D200210").Clear ) to each file. Also the string name for my code does not matter, the info in the sheet does not either. My original code was to test if it looped at all.
So from what I can see you try to delete everything but the first row inside a .csv file. A .csv file is not a worksheet(even though you can import it into excel), so you can't use the Range property.
Fortunately, there is an even easier way to do this, just use the Microsoft Scripting Runtime to edit the .csv file.
Set aText = aFile.OpenAsTextStream(ForReading) ' open file in read mode
singleLine = aText.ReadLine ' read the first line and store it
Set aText = aFile.OpenAsTextStream(ForWriting) ' open file in write mode
aText.Write (singleLine) 'write the line you saved before
Or even more compact:
aFile.OpenAsTextStream(ForWriting).Write aFile.OpenAsTextStream(ForReading).ReadLine 'overwrites the file with what was written in the first line.
The advantage with the longer code is the ability to use the string somewhere else, for example storing it somewhere in your workbook.
I'm trying to create a small VB-application that removes the internal link in Word Documents, to their templates.
I have found this guide
http://word.tips.net/Pages/T001437_Batch_Template_Changes.html
and am trying to modify it, to use with VBA instead of Macro programming inside of Office.
However, I'm getting stuck on how to get the Document.Open to work. Any help is appreciated.
This is supposed to run as a free-standing application, and not runt from within Word.
I'm looking for a way to perform what the Macro does, but not from within Word.
There are two pieces of bad news to give here.
1) A document has to have a template. You cannot remove it, only change it to something else.
2) Changing a template does nothing anyway. See this page.
I am wonder if the problem with the Open method is that you are trying to open ".doc" extension files, not the modern ".docx" extension files. The VBA subroutine you linked to only does ".doc" files. This VBA code does both:
Function StringEndsWith( _
ByVal strValue As String, _
CheckFor As String) As Boolean
Dim sCompare As String
Dim lLen As Long
lLen = Len(CheckFor)
If lLen > Len(strValue) Then Exit Function
sCompare = Right(strValue, lLen)
StringEndsWith = StrComp(sCompare, CheckFor, vbTextCompare) = 0
End Function
Sub ChangeTemplates()
Dim strDocPath As String
Dim strTemplateB As String
Dim strCurDoc As String
Dim docCurDoc As Document
' set document folder path and template strings
strDocPath = "C:\tmp\"
' get first doc - only time need to provide file spec
strCurDoc = Dir(strDocPath & "*.doc*")
' ready to loop (for as long as file found)
Do While strCurDoc <> ""
If (StringEndsWith(strCurDoc, ".doc") Or StringEndsWith(strCurDoc, ".docx")) Then
' open file
Set docCurDoc = Documents.Open(FileName:=strDocPath & strCurDoc)
' change the template back to Normal
docCurDoc.AttachedTemplate = ""
' save and close
docCurDoc.Close wdSaveChanges
End If
' get next file name
strCurDoc = Dir
Loop
MsgBox "Finished"
End Sub
long time between answers but may be useful to others. If you have access to the VBE of the Word document [Alt F11], and you want to remove the reference then go to "Tools/References" [top menu] and deselect it from the list of reference files. I had a similar issue where template no longer existed, but it was still being 'referenced' in the Project window, so I did the above.
Is there a way to determine whether or not a Word document (specifically 2007, if that matters) contains a restricted font using VBA?
I don't necessarily need a way to remove the font, just to determine whether or not the document contains an restricted font. Also, if there's only a way to check for an embedded font, that's acceptable, because in my case, it will almost always be a restricted font.
As you're using Word 2007 you can try to inspect the OOXML of the document to check whether a particular font is embedded or not. As far as I can determine, if it is embedded then in the XML, the font will have one or more of the following child nodes:
< w:embedRegular>
< w:embedBold>
< w:embedItalic>
< w:embedBoldItalic>
(had to put in spaces otherwise it would not display correctly)
More information here: http://msdn.microsoft.com/en-us/library/documentformat.openxml.wordprocessing.font.aspx
Based on this, you can then put something together to extract this information - I threw together an example below that looks at the active document.
I have to admit this is not that pretty and it could certainly do with some optimisation, but it does the job. Don't forget to add a reference to MSXML to your VBA project.
' returns a delimited list of fonts that are embedded
Function GetEmbeddedFontList(Optional ByVal sDelimiter As String = ";") As String
Dim objDOMDocument As MSXML2.DOMDocument30
Dim objXMLNodeList As MSXML2.IXMLDOMNodeList
Dim objXMLNodeListEmbed As MSXML2.IXMLDOMNodeList
Dim lNodeNum As Long
Dim lNodeNum2 As Long
Dim sFontName As String
Dim sReturnValue As String
On Error GoTo ErrorHandler
sReturnValue = ""
Set objDOMDocument = New MSXML2.DOMDocument30
objDOMDocument.LoadXML ActiveDocument.WordOpenXML
' grab the list of fonts used in the document
Set objXMLNodeList = objDOMDocument.SelectNodes("//w:fonts/w:font")
For lNodeNum = 0 To objXMLNodeList.Length - 1
' obtain the font's name
sFontName = objXMLNodeList.Item(lNodeNum).Attributes(0).Text
'check its child nodes to see if any contain the word "embed", if so, then the font is embedded
For lNodeNum2 = 0 To objXMLNodeList.Item(lNodeNum).ChildNodes.Length - 1
If objXMLNodeList.Item(lNodeNum).ChildNodes(lNodeNum2).nodeName Like "*embed*" Then
sReturnValue = sReturnValue & sFontName & sDelimiter ' add it to the list
Exit For
End If
Next lNodeNum2
Next lNodeNum
ErrorExit:
GetEmbeddedFontList = sReturnValue
Exit Function
ErrorHandler:
sReturnValue = ""
Resume ErrorExit:
End Function