I need to find the first 20,000 random numbers generated by RND -1. I have written the following code, which allows me to see those numbers in the Immediate Window:
Sub xx()
Dim i As Long
Rnd -1
For i = 1 To 20000
Debug.Print Rnd
Next i
End Sub
However, only the last 199 lines are stored there for me to copy and paste. How can I write the entire output to a text file instead?
Many thanks
Since your goal seems to be to get a lot of random numbers in the clipboard, you can do the following:
in the VBA editor under tools/references, add a reference to Microsoft Forms 2.0 Object Library and then use:
Sub RandToClip(n As Long)
Dim clip As New DataObject
Dim A As Variant
Dim i As Long
ReDim A(1 To n)
Randomize
For i = 1 To n
A(i) = Rnd()
Next i
clip.SetText Join(A, vbCrLf)
clip.PutInClipboard
End Sub
If you then e.g. enter RandToClip 20000 in your clipboard available for pasting somewhere else.
You can easily write to a text file (file stream) by using a FileSystemObject. See example below for working code in a module:
Global fso As New FileSystemObject
Public Function GenRandomNumbers(ByVal n As Long) As String
Dim i As Long
Dim res As String
Rnd -1
For i = 1 To n
res = res & CStr(Rnd()) & vbCrLf
Next i
GenRandomNumbers = res
End Function
Public Sub WriteRandomNumbers(ByVal n As Long, ByVal filename As String)
Dim fs As TextStream
Set fs = fso.CreateTextFile(filename, Overwrite:=True)
fs.Write GenRandomNumbers(n)
fs.Close
End Sub
In the immediate window you can write:
WriteRandomNumbers 20000, "Result.txt"
Answering your question: here is the basic function for that task. Make sure to add checks of whether file exists, not locked, etc. But take a look at the solution provided by John Coleman as it may be a better solution for your task.
Public Function WritetoTXT (Byval Text as String, byval FilePath as String)
Dim TextFile As Long
TextFile = FreeFile
Open Path For Append As TextFile
Print #TextFile, Text
Close TextFile
End Function
In your code:
Sub xx()
Dim i As Long
Rnd -1
For i = 1 To 20000
WritetoTXT Rnd, "your file path here"
Next
End Sub
Edit:
As pointed out in comments to decrease overhead you can combine your code to the following:
Sub xx()
Dim i As Long
Rnd -1
Dim TextFile As Long
TextFile = FreeFile
Open "your file path here" For Append As TextFile
For i = 1 To 20000
Print #TextFile, Rnd
Next
Close TextFile
End Sub
Related
I'm currently working on a macro that creates a PDF from a SolidWorks file and then, if the Solidworks File is an assembly, it would merge the pdf with its BOM.
The problem is that I've coded the merge part of the macro, but I keep getting a "False" result on the merge line of my code and I can't find why...
Once it will be debugged, this will become a Function that will get 2 file paths to merge.
Can you help me make the macro actually merge the two files? I can't find anything about why it can return a false results.
So thank you for your help!
Here's my actual code:
Sub CombinePDFs() '(ByVal NewAsmPdf As String, ByVal OldAsmPdf As String)
' The function will combine the PDFs keeping the BOM of the older file merged (The one which is replaced)
Dim Adobe As AcroPDDoc
Dim PDF1 As Object
Dim PDF2 As Object
Dim PageNF As Long
Dim PageOF As Long
Dim b As Byte
Dim NewAsmPdf As String
Dim OldAsmPdf As String
NewAsmPdf = "Path.PDF"
OldAsmPdf = "Path_BOM.PDF"
' Defines the two PDFs to be merged
Set PDF1 = CreateObject("AcroExch.PDDoc")
PDF1.Open (NewAsmPdf)
Set PDF2 = CreateObject("AcroExch.PDDoc")
PDF2.Open (OldAsmPdf)
'Get the pages to be keep
PageNF = PDF1.GetNumPages
PageOF = PDF2.GetNumPages - PageNF
'Insert PDF2 BOM in PDF1
If PDF1.InsertPages(PageNF, PDF2, PageNF + 1, PageOF, 0) Then 'Here is my problem : Keep having false (No merge)
Kill (OldAsmPdf)
Else
MsgBox ("Could not merge the Old and New file")
End If
End Sub
SOLVED!
I found out that VBA counts from 0 (So page 1 is actually the page 0) so the false was returned due to impossible values in attributes.
Here's the code of the function that I've done:
Function CombinePDFs(ByVal NewAsmPdf As String, ByVal OldAsmPdf As String)
' The function will combine the 2 PDFs and replace the OldFile by the NewFile
Dim PDF1 As Object
Dim PDF2 As Object
Dim PageNF As Long
Dim PageOF As Long
Dim NewAsmPdf As String
Dim OldAsmPdf As String
' Defines the two PDFs to be merged
Set PDF1 = CreateObject("AcroExch.PDDoc")
PDF1.Open (NewAsmPdf)
Set PDF2 = CreateObject("AcroExch.PDDoc")
PDF2.Open (OldAsmPdf)
'Get the pages to be keep
PageNF = PDF1.GetNumPages
PageOF = PDF2.GetNumPages
' Insert PDF2 BOM in PDF1
If PDF1.InsertPages(PageNF - 1, PDF2, PageNF, PageOF-1, 0)
If Not PDF1.Save(PDSaveFill, NewAsmPdf) Then
MsgBox ("Not saved")
End If
' Delete "_BOM.PDF" file
PDF2.Close
Kill (OldAsmPdf)
Else
MsgBox ("Could not merge the Old and New file")
End If
' Clear memory
Set PDF1 = Nothing
Set PDF2 = Nothing
End Function
Have fun!
Trying to create a console application to copy directories from the source to the destination and either the progress bar does nothing while files are copied...
My.Computer.FileSystem.CopyDirectory(source, destination)
For i = 1 To 100
Console.Write(String.Format("Copy progress: {0}%" & vbCr, i))
Threading.Thread.Sleep(100)
Next
or the ProgressBar says "Copy Progress 1%" the entire time it's copying...
For i = 1 To 100
Console.Write(String.Format("Copy progress: {0}%" & vbCr, i))
My.Computer.FileSystem.CopyDirectory(source, destination)
Threading.Thread.Sleep(100)
Next
Wondering what I am doing wrong because I am obviously putting the My.Computer line in the wrong spot!
A simple solution, using Linq Select to copy the file list returned by DirectoryInfo.GetFiles()
Pass the sample method an array of Source Directories and a Destination Directory.
The progress (0-100%) is printed to the Output window, and a ProgressBar gives a visual feedback of the copy status for each Source Path.
This method will return the list of all files copied.
Dim sourcePath As String() = New String() {"[SourcePath1]", "[SourcePath2]", "[SourcePath3]"}
Dim destinationPath As String = "[DestinationPath]"
Dim filesCopied As List(Of String) = CopyDirectoryWithProgress(sourcePath, destinationPath)
Console.ReadLine()
Private Function CopyDirectoryWithProgress(sourcePath As String(), destPath As String) As List(Of String)
Dim allFilesCopied As List(Of String) = New List(Of String)
Dim progressBarPassSymbol As Char = ChrW(&H25A0)
Dim progressBarEmptySymbol As String = New String(ChrW(&H2014), 30)
For Each sPath As String In sourcePath
Dim fileInfo As New DirectoryInfo(sPath).GetFiles()
Dim numberOfFiles As Integer = fileInfo.Length - 1
Dim progressBarPass As Double = (30 / numberOfFiles)
Dim increment As Double = 100 / numberOfFiles
Directory.CreateDirectory(destPath)
Console.CursorLeft = 0
Console.Write("Copy progress: ")
Console.CursorLeft = 20
Console.Write(progressBarEmptySymbol)
allFilesCopied.AddRange(fileInfo.
Select(Function(f, i)
File.Copy(Path.Combine(sPath, f.Name), Path.Combine(destPath, f.Name), True)
Console.CursorLeft = 15
Console.Write("{0:g}% " &
New String(progressBarPassSymbol, CInt((i + 1) * progressBarPass)),
CInt((i + 1) * increment))
Return f.FullName
End Function))
Console.WriteLine()
Next
Return allFilesCopied
End Function
For an interesting method to perform this task with a much faster file enumerator, see this CodeProject article: A Faster Directory Enumerator
You can invoke the Windows built-in progress bar when copying using the UIOption.AllDialogs:
My.Computer.FileSystem.CopyFile("C:\text.txt", "C:\my_folder\text.txt", FileIO.UIOption.AllDialogs, FileIO.UICancelOption.DoNothing)
In my program, I collect bits of information on a massive scale, hundreds of thousands to millions of lines each. I am trying to limit each file I create to a certain size in order to be able to quickly open it and read the data. I am using a HashSet to collect all the data without duplicates.
Here's my code so far:
Dim Founds As HashSet(Of String)
Dim filename As String = (Environment.GetFolderPath(Environment.SpecialFolder.Desktop) + "\Sorted_byKING\sorted" + Label4.Text + ".txt")
Using writer As New System.IO.StreamWriter(filename)
For Each line As String In Founds
writer.WriteLine(line)
Next
Label4.Text = Label4.Text + 1 'Increments sorted1.txt, sorted2.txt etc
End Using
So, my question is:
How do I go about saving, let's say 250,000 lines in a text file before moving to another one and adding the next 250,000?
First of all, do not use Labels to simply store values. You should use variables instead, that's what variables are for.
Another advice, always use Path.Combine to concatenate paths, that way you don't have to worry about if each part of the path ends with a separator character or not.
Now, to answer your question:
If you'd like to insert the text line by line, you can use something like:
Sub SplitAndWriteLineByLine()
Dim Founds As HashSet(Of String) 'Don't forget to initialize and fill your HashSet
Dim maxLinesPerFile As Integer = 250000
Dim fileNum As Integer = 0
Dim counter As Integer = 0
Dim filename As String = String.Empty
Dim writer As IO.StreamWriter = Nothing
For Each line As String In Founds
If counter Mod maxLinesPerFile = 0 Then
fileNum += 1
filename = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Desktop),
$"Sorted_byKING\sorted{fileNum.ToString}.txt")
If writer IsNot Nothing Then writer.Close()
writer = New IO.StreamWriter(filename)
End If
writer.WriteLine(line)
counter += 1
Next
writer.Dispose()
End Sub
However, if you will be inserting the text from the HashSet as is, you probably don't need to write line by line, instead you can write each "bunch" of lines at once. You could use something like the following:
Sub SplitAndWriteAll()
Dim Founds As HashSet(Of String) 'Don't forget to initialize and fill your HashSet
Dim maxLinesPerFile As Integer = 250000
Dim fileNum As Integer = 0
Dim filename As String = String.Empty
For i = 0 To Founds.Count - 1 Step maxLinesPerFile
fileNum += 1
filename = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Desktop),
$"Sorted_byKING\sorted{fileNum.ToString}.txt")
IO.File.WriteAllLines(filename, Founds.Skip(i).Take(maxLinesPerFile))
Next
End Sub
I am trying to write a string to a .csv file, but unable to get it to display.
I have managed to do it in VBA, but when writing in VB.net it's not working.
I first create the file and set the headers for each column. After this I am getting information on each required attribute and writing it to a string s.
All i want to do now is write the string to the .csv file so that each attribute is in the right column under the right header.
Each time the string s simply needs to be on a new row.
This is what I have so far (I have cut out some bits of code so some syntax may look incorrect). What am i doing wrong or missing?
Sub Main()
Dim sOutput As String
' Create a header for the output file
sOutput = ("Level,Occurrence Name,Reference Name,Object type, Visibility, Path" & vbLf)
If Occs.Count > 0 Then
For i = 1 To Occs.Count
iLevel = 0
curOcc = Occs.Item(i)
GetOccurrenceData(curOcc, sOutput, oSel, False, iLevel)
Next
End If
' Write the output string to a file
Dim sPath As String
Dim bWrite As Boolean
sPath = ("C:\temp\data3.csv")
bWrite = WriteFile(sPath, sOutput)
End Sub
Sub GetOccurrenceData(curOcc As VPMOccurrence, s As String, sel As Selection, ByVal bParentHidden As Boolean, ByVal iParentLevel As Integer)
'CODE TO GET DATA REMOVED AS IRRELEVANT
' Append the output string with the data for the current occurrence.
s = (s & curLevel & "," & sName & "," & sRefName & "," & sType & "," & sVisibility & vbLf)
' Repeat this data gathering procedure on any children the current occurrence may have.
Occs = curOcc.Occurrences
If Occs.Count > 0 Then
For i = 1 To Occs.Count
GetOccurrenceData(Occs.Item(i), s, sel, bChildrenInheritNoShow, curLevel)
Next
End If
In GetOccurrenceData you pass in a string and change it in the method, but you did not pass it in as a ByRef so anything done to the string in the method stays in the method.
Change the header of your method to read
Sub GetOccurrenceData(curOcc As VPMOccurrence,ByRef s As String, sel As Selection, ByVal bParentHidden As Boolean, ByVal iParentLevel As Integer)
I would however recommend using a StringBuilder to accomplish what you are doing.
Like This:
Sub Main()
Dim sb As New Text.StringBuilder()
sb.AppendLine("Level,Occurrence Name,Reference Name,Object type, Visibility, Path")
If Occs.Count > 0 Then
For i = 1 To Occs.Count
iLevel = 0
curOcc = Occs.Item(i)
GetOccurrenceData(curOcc, sb, oSel, False, iLevel)
Next
End If
' Write the output string to a file
Dim sPath As String
Dim bWrite As Boolean
sPath = ("C:\temp\data3.csv")
bWrite = WriteFile(sPath, sb.ToString())
End Sub
Sub GetOccurrenceData(curOcc As VPMOccurrence, sb As Text.StringBuilder, sel As Selection, ByVal bParentHidden As Boolean, ByVal iParentLevel As Integer)
'CODE TO GET DATA REMOVED AS IRRELEVANT
' Append the output string with the data for the current occurrence.
sb.Append(curLevel).Append(",").Append(sName).Append(",").Append(sRefName).Append(",").Append(sType).Append(",").AppendLine(sVisibility)
' Repeat this data gathering procedure on any children the current occurrence may have.
Occs = curOcc.Occurrences
If Occs.Count > 0 Then
For i = 1 To Occs.Count
GetOccurrenceData(Occs.Item(i), sb, sel, bChildrenInheritNoShow, curLevel)
Next
End If
End Sub
the vb.net code below permutates a given word...the problem i have is that it does not accept larger words like "photosynthesis", "Calendar", etc but accepts smaller words like "book", "land", etc ...what is missing...Pls help
Module Module1
Sub Main()
Dim strInputString As String = String.Empty
Dim lstPermutations As List(Of String)
'Loop until exit character is read
While strInputString <> "x"
Console.Write("Please enter a string or x to exit: ")
strInputString = Console.ReadLine()
If strInputString = "x" Then
Continue While
End If
'Create a new list and append all possible permutations to it.
lstPermutations = New List(Of String)
Append(strInputString, lstPermutations)
'Sort and display list+stats
lstPermutations.Sort()
For Each strPermutation As String In lstPermutations
Console.WriteLine("Permutation: " + strPermutation)
Next
Console.WriteLine("Total: " + lstPermutations.Count.ToString)
Console.WriteLine("")
End While
End Sub
Public Sub Append(ByVal pString As String, ByRef pList As List(Of String))
Dim strInsertValue As String
Dim strBase As String
Dim strComposed As String
'Add the base string to the list if it doesn't exist
If pList.Contains(pString) = False Then
pList.Add(pString)
End If
'Iterate through every possible set of characters
For intLoop As Integer = 1 To pString.Length - 1
'we need to slide and call an interative function.
For intInnerLoop As Integer = 0 To pString.Length - intLoop
'Get a base insert value, example (a,ab,abc)
strInsertValue = pString.Substring(intInnerLoop, intLoop)
'Remove the base insert value from the string eg (bcd,cd,d)
strBase = pString.Remove(intInnerLoop, intLoop)
'insert the value from the string into spot and check
For intCharLoop As Integer = 0 To strBase.Length - 1
strComposed = strBase.Insert(intCharLoop, strInsertValue)
If pList.Contains(strComposed) = False Then
pList.Add(strComposed)
'Call the same function to review any sub-permutations.
Append(strComposed, pList)
End If
Next
Next
Next
End Sub
End Module
Without actually creating a project to run this code, nor knowing how it 'doesn't accept' long words, my answer would be that there are a lot of permutations for long words and your program is just taking much longer than you're expecting to run. So you probably think it has crashed.
UPDATE:
The problem is the recursion, it's blowing up the stack. You'll have to rewrite your code to use an iteration instead of recursion. Generally explained here
http://www.refactoring.com/catalog/replaceRecursionWithIteration.html
Psuedo code here uses iteration instead of recursion
Generate list of all possible permutations of a string