Excel VBA: Make InStr find whole string, not part of it - vba

I'm trying to make a login/register system.
This is the registration UserForm.
Private Sub regReg_Click()
Dim TextFile As Integer
Dim FilePath As String
If regAParole.Text = "aparole" Then
FilePath = ThisWorkbook.Path & "\accounts.txt"
TextFile = FreeFile
Open FilePath For Append As #1
Print #TextFile, regID; regAmats; regParole
Close TextFile
MsgBox ("Registracija veiksmiga.")
Unload Registracija
Else
MsgBox ("Nepareiza administratora parole.")
End If
End Sub
The "aparole" thing is basically just a keyword to enter in a field so only administrators can create new accounts.
accounts.txt content looks like:
1DirectorPassword (ID+jobposition+password)
This is the authentication:
Private Sub logAuth_Click()
Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String
Dim find As String
Dim result As Integer
find = logID & logAmats & logParole
FilePath = ThisWorkbook.Path & "\accounts.txt"
TextFile = FreeFile
Open FilePath For Input As TextFile
FileContent = Input(LOF(TextFile), TextFile)
result = InStr(FileContent, find)
If result >= 1 Then
MsgBox ("Autorizacija veiksmiga!") ' Success
Unload Autorizacija
End If
Basically when logging in I search within the accounts.txt for the string combo (ID+jobposition+password) which I use when registering. So in general the approach works, but:
If I enter everything perfectly matched = works great
If I enter the password half of it, like in a format of = 1DirectorPass it still works, so basically how can I tell to only search for the whole string and not parts of it?
I think the issue lies within InStr...

You could test for the newline markers in your file content, like this:
result = InStr(vbCrLf & FileContent, vbCrLf & find & vbCrLf)
This will only match complete lines. An extra newline is added before the file content so also the first line can be matched. At the end of the file content you would already have a vbCrLf character, because Print is supposed to add that.

Related

VBA - Reading a text file, splitting it into array and printing it back in VBA Word

Hello I would like to take my txt file containing string of data, split it into array by line. However, I am not able to either input data to array correctly or I have problem with the function GetArrLength. I am pretty new to VBA and can't figure the problem out. The macro stops with Run-time error '13': type mismatch and highlights this section of the code:
GetArrLength = UBound(arr) - LBound(arr) + 1
Hopefully it's not a big issue.
Thanks for any ideas.
Sub apokus()
'PURPOSE: Send All Data From Text File To A String Variable
Dim TextFile As Integer
Dim filePath As String
Dim FileContent As String
Dim strAll As String
Dim arrString() As String
'File Path of Text File
filePath = InputBox("Path to your MD file.", "Path to MD", "actual path to the file")
'Determine the next file number available for use by the FileOpen function
TextFile = FreeFile
'Open the text file
Open filePath For Input As TextFile
'Store file content inside a variable
FileContent = Input(LOF(TextFile), TextFile)
Close TextFile
arrString = Strings.Split(FileContent, vbCr)
Selection.TypeText Text:=GetArrLength(1)
Dim i As Long
For i = 1 To GetArrLength(arrString)
Selection.TypeText Text:=GetArrLength(i) + vbNewLine
Next i
End Sub
Public Function GetArrLength(arr As Variant) As Long
If IsEmpty(arr) Then
GetArrLength = 0
Else
GetArrLength = UBound(arr) - LBound(arr) + 1
End If
End Function
Your code should be as follows:
arrString = Strings.Split(FileContent, vbCr)
Selection.TypeText Text:=GetArrLength(arrString)
Dim i As Long
For i = 0 To UBound(arrString)
Selection.TypeText Text:=arrString(i) + vbNewLine
Next i
However, I can't see the point of your code. You take a text file that contains a number of paragraphs, remove the carriage returns, then insert the text into Word adding carriage returns back in.

How to read all information from shell command in VBA and save it in .txt file

I try to use this code:
Shell(nppPath & " " & fileToOpen, vbNormalFocus)
which opens txt file nppPath = "C:\Windows\notepad.exe" but I cannot read from it and save it as .txt file using VBA.
Looking forward to any suggestions.
I'm presuming you copied the nppPath over wrong as it should be
nppPath = "C:\Windows\System32\notepad.exe"
but for reading from the text file you could use free file:
Dim IntFile As Integer, StrFileName As String, StrFileContent As String
StrFileName = fileToOpen 'Your file location here
IntFile = FreeFile
Open StrFileName For Input As #IntFile
StrFileContent = Input(LOF(IntFile), IntFile) 'This now contains the text
Close #IntFile
This will read the text file into a single variable that you can then use however you wish.
If you want to write to a text file you can use the following code:
Dim StrNewLocation As String, StrFileContent As String
StrNewLocation = "" 'Put the new files name and location here
StrFileContent = "Example" 'The text to go into the new file
Open StrNewLocation For Output As #1
Write #1, StrFileContent
Close #1
Hopefully this helps you solve your problem if not send me a message and I'll see what I can do.

Removing compatibility mode on 1000+ word documents

I have a folder containing about 1200 word documents that are all saved in Compatibility Mode. Does anyone know of a way to convert every one of these files so that the documents are no longer in Compatibility Mode?
Open up a cmd window in your folder and type dir /s /b >> filename.txt to get a plaintext list of all the files in the path. That will give a textfile listing all files in the directory.
Use that as the input for the following
Since you're going to do it on 1000 files, I would set a break point at doc.close to test it out on the first few if I were you.
Sub SaveAsDocX(FileListFullPath As String)
'for saving to new filename
Dim newname As String
'array of docs, items in that array, document object from those items
Dim docs As Variant
Dim item As Variant
Dim doc As Document
docs = getfiles(FileListFullPath)
For Each item In docs
If Right(item, 4) = ".doc" Then
Set doc = Application.Documents.Open(FileName:=item)
doc.Activate
newname = item & " - updated.docx"
'first save as new format then update compatibility, then save again
doc.SaveAs2 FileName:=newname, FileFormat:=wdFormatDocumentDefault
ActiveDocument.SetCompatibilityMode (wdCurrent)
doc.SaveAs2 FileName:=newname, FileFormat:=wdFormatDocumentDefault
doc.Close
End If
Next
End Sub
Function getfiles(Optional FileName As String = "Dir.txt")
Dim FileList() As String
Open FileName For Input As #1
FileList = Split(Input$(LOF(1), #1), vbCrLf)
Close #1
getfiles = FileList
End Function

FileSave() Word Macro

I have written a macro which when a file is created and the little save button is clicked the macro is triggered(as it overrides the default FileSave function). The macro extracts information from a table in my document, converts it to a string then cleanses that string of any carriage returns then uses that as the file name. An if statement then runs checking whether a hidden row in the table has a value of 1 and if not then it will set the value to 1 and save the document at the location specified with the new filename.
All of this works great except when I re-open the file to edit it, as my users will do, and click save again it tries to run everything again, completely ignoring my If statements first statement and will add a carriage return to the start of the filename effectively breaking the save function to SharePoint as it has an invalid character in it. If you then click save again it will seemingly run the macro as normal and save it by actually reading the if statement correctly. Am I doing something wrong here?
Here is the code:
Sub FileSave()
Dim strText As String
Dim strClean As String
Dim strFileName As String
Dim strLocation As String
Dim strSavedName As String
Dim strCleanSave As String
strText = ActiveDocument.Tables(1).Rows(1).Cells(2).Range.Text
strClean = Application.CleanString(strText)
strFileName = strClean + "_" + Format(Date, "yyyy-mm-dd")
strLocation = "[My SharePoint Site]"
If ActiveDocument.Tables(1).Rows(1).Cells(3).Range.Text = "1" Then
strSavedName = ActiveDocument.Name
strCleanSave = Application.CleanString(strSavedName)
ActiveDocument.SaveAs FileName:=strSavedName
Exit Sub
Else
ActiveDocument.Tables(1).Rows(1).Cells(3).Range.Text = "1"
ActiveDocument.SaveAs FileName:=strLocation & strFileName & ".docx"
End If
End Sub
Word table cell text ranges are terminated with two hidden chars, a carriage return (ASCII 13) and a bell (ASCII 7). Your IF condition returns false because it is testing the equivalence of "1" and "1" & Chr(13) & Chr(7).
In your case you can limit the test to the first char:
If Left$(ActiveDocument.Tables(1).Rows(1).Cells(3).Range.Text, 1) = "1" Then
More generally you can test the visible cell contents with a Len() - 2.
Hope that helps.

How to change section text in INI file using Word VBA

I have to change the section in an ini-file using Word VBA.
I know how to change the values of the keys, but can anyone tell me how to change the value of a section (the first section = the only section)?
In the example below I like to change OldName in NewName.
[Offices]
Office1=OldName
[OldName]
Key1=value
Key2=value
etc.
Thanks,
Kem
You can use this code to replace text in any text file
Public Sub Test()
ReplaceInTXT "C:\folder\file.ini", "[OldName]", "[NewName]"
End Sub
Public Sub ReplaceInTXT(sFileName As String, sFind As String, sReplace As String)
Dim Content As String
Dim hFile As Long
hFile = FreeFile
Open sFileName For Input As #hFile
Content = Input$(LOF(hFile), hFile)
Close #hFile
Content = Replace(Content, sFind, sReplace)
Open sFileName For Output As #1
Print #1, Content
Close #1
End Sub
Please make sure to have a backup first. I don't want to mess up the file