I'm working on some code that requires lots of data to be stored and I want to write a new data type for these to be placed into.
Private Sub CommandButton1_Click()
Dim myFile As String, text As String
myFile = Application.GetOpenFilename()
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, text
'Check to see if line contains name
If InStr(text, "name=") <> 0 Then
'Trim down to just name
text = Replace(text, "name=", "")
text = Trim(text)
'Set the current value of text as name of new scalarIn
Dim text As scalarIn
End If
Loop
End Sub
I don't think this works but its more to help understand the idea. What I want to happen is to read in a name from a file and set it as the name of a new instance of my custom data type.
Public Type scalarIn
UnitOfMeasure As String
Value As Variant
Source As String
End Type
Related
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.
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.
I have this .dwg file that has hundreds of block references.
I am trying to create hyperlink to a pdf file from all of the block references. The pdf are on my D drive.
For example, names of the block refernece are: '2:test', '26:test', '234:test'. Essentially hyperlink for
each point would be: '2:test' would hyperlink to D:\Reports\File-002.pdf;
'26:test' would hyperlink to D:\Reports\File-026.pdf; '234:test' would hyperlink to D:\Reports\File-234.pdf.
From block
references i get the number before the ':', and its matching pdf would be 'File-' followed by the number before ':' in 3 digits.
There are lot of these to do by hands, and i think i can program for this.
I have enough basic programming knowledge to manipulate the string to get my number and convert it in 3 digits. The question i have
and/or need help is with how to cycle through each block reference(for loop) on the file and be able to write to its hyperlink property? Is this even possible?
Before coming here i kind of looked at these links but they did not prove helpful:
Link1; Link2; Link3
Thanks for the hints
UPDATE
Private Sub CommandButton1_Click()
Dim ReadData As String
Open "C:\Desktop\Files\DesignFile.DWG" For Input As #1
Do Until EOF(1)
Line Input #1, ReadData
MsgBox ReadData 'Adding Line to read the whole line, not only first 128 positions
Loop
Close #1
End Sub
You can try this:
Dim stringInput
stringInput = "2:test', '26:test', '234:test"
stringSplit = Split(stringInput, ",")
For i = 0 To UBound(stringSplit)
Debug.Print (stringSplit(i))
Next i
Outputs:
2:test'
'26:test'
'234:test
you can try this
Option Explicit
Sub test()
Dim acBlockRef As AcadBlockReference
Dim baseStrng As String
baseStrng = "D:\Reports\File-"
For Each acBlockRef In BlockRefsSSet("BlockRefs")
acBlockRef.Hyperlinks.Add("PDF").URL = baseStrng & Format(Left(acBlockRef.Name, InStr(acBlockRef.Name, "-") - 1), "000") & ".pdf"
Next acBlockRef
ThisDrawing.SelectionSets("BlockRefs").Delete
End Sub
'-----------------------------------------------------------------
'helper functions
'------------------
Function BlockRefsSSet(ssetName As String, Optional acDoc As Variant) As AcadSelectionSet
'returns a selection set of all block references in the passed drawing
Dim acSelSet As AcadSelectionSet
Dim Filtertype(0) As Integer
Dim Filterdata(0) As Variant
Set BlockRefsSSet = CreateSelectionSet(ssetName, acDoc)
Filtertype(0) = 0: Filterdata(0) = "INSERT"
BlockRefsSSet.Select acSelectionSetAll, , , Filtertype, Filterdata
End Function
Function CreateSelectionSet(selsetName As String, Optional acDoc As Variant) As AcadSelectionSet
'returns a selection set with the given name
'if a selectionset with the given name already exists, it'll be cleared
'if a selectionset with the given name doesn't exist, it'll be created
Dim acSelSet As AcadSelectionSet
If IsMissing(acDoc) Then Set acDoc = ThisDrawing
On Error Resume Next
Set acSelSet = acDoc.SelectionSets.Item(selsetName) 'try to get an exisisting selection set
On Error GoTo 0
If acSelSet Is Nothing Then Set acSelSet = acDoc.SelectionSets.Add(selsetName) 'if unsuccsessful, then create it
acSelSet.Clear 'cleare the selection set
Set CreateSelectionSet = acSelSet
End Function
'-----------------------------------------------------------------
with following notes:
you can't have a colon (":") in a block name
so I used a hypen ("-") as its substitute
every block reference object will be attached the URL ("D:\Reports\File-nnn.pdf") associated with the block name it's a reference of
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
I'm looping through an input file and using the readline command to read each line, check it for various criteria, then I want to make changes based on the result. Here is a very simple version of what I'm trying to do:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strFileLoc, 1)
Do While Not objFile.AtEndOfStream
strLineRead = objFile.readline
if strLineRead Like "*text to change*" Then
'Some code to change the line
end if
Loop
What I've been doing is saving the entire file to a string called strFileText, and then using a Replace function to replace the strLineRead within that string with the changed version. Something like this:
strFileText = Replace(strFileText, strLineRead, strNewLine)
and then write that entire string to a new text file.
The problem is, sometimes I might have a line where it's entire text is "NC", and then doing a find/replace on the entire file for "NC" changes more than just the one line.
So is there a command in the FileSystemObject, while on a certain line, to be able to alter the file directly? I'm thinking something like a "writeline" command.
Have these private subs somewhere in your file and on an event, call them. First call replace_text and fill it with the requirements. See my sample code.
Private Sub Command3_Click()
Dim sFileName As String
Dim fileSys As Variant
' Edit as needed
sFileName = Me.FileList.Value
Set fileSys = CreateObject("Scripting.FileSystemObject")
Replace_Text sFileName, "bad text", "good text", fileSys
End Sub
Private Sub Replace_Text(targetFile As String, targetText As String, replaceText As String, fileSys As Variant)
If Right(targetFile, 3) = "filepath extension you want (example: xml or doc etc.)" Then
Update_File targetFile, targetText, replaceText, fileSys
Else
MsgBox "You did not select the right file. Please try again."
End If
End Sub
Private Sub Update_File(fileToUpdate As String, targetText As String, replaceText As String, fileSys As Variant)
Dim tempName As String
Dim tempFile As Variant
Dim file As Variant
Dim currentLine As String
Dim newLine As String
'creates a temp file and outputs the original files contents but with the replacements
tempName = fileToUpdate & ".tmp"
Set tempFile = fileSys.CreateTextFile(tempName, True)
'open the original file and for each line replace any matching text
Set file = fileSys.OpenTextFile(fileToUpdate)
Do Until file.AtEndOfStream
currentLine = file.ReadLine
newLine = Replace(currentLine, targetText, replaceText)
'write to the new line containing replacements to the temp file
tempFile.WriteLine newLine
Loop
file.Close
tempFile.Close
'delete the original file and replace with the temporary file
fileSys.DeleteFile fileToUpdate, True
fileSys.MoveFile tempName, fileToUpdate
End Sub