I have an Excel sheet in one folder and try to merge certain files within this folder to one file using the following code:
Private Sub CommandButton1_Click()
Dim RET As Variant
RET = Shell("cmd.exe copy files1.txt + file2.txt out.txt", 0)
End Sub
As a return value for RET i get 1560. No error while debugging, but no "out.txt" either.
What's wrong with my code? Thanks
I think you miss the /C in the cmd arguments and the path.
Private Sub CommandButton1_Click()
Dim RET As Variant
RET = Shell("cmd.exe /C copy C:\Data\files1.txt + C:\Data\file2.txt C:\Data\out.txt", 0)
End Sub
The return value not equal 0 indicates the process is started (it is the actual process id)
The VBA way;
Function readFile(path) As String
On Error GoTo ERR_IO
Dim hF As Integer: hF = FreeFile
Open path For Input As #hF
readFile = Input$(LOF(hF), hF)
ERR_IO:
Close #hF
End Function
Function writeFile(path, buffer) As Boolean
On Error GoTo ERR_IO
Dim hF As Integer: hF = FreeFile
Open path For Output As #hF
Print #hF, buffer
writeFile = True
ERR_IO:
Close #hF
End Function
Sub merge()
Dim buffer As String
buffer = readFile("C:\xxx\files1.txt")
buffer = buffer & readFile("C:\xxx\files2.txt")
writeFile "c:\xxx\out.txt", buffer
End Sub
Related
Want to check if there is a worksheet with the same name as the file.
At the moment I have filnam opening the files as an array but want it to cycle through the code and see if there is a worksheet with the same name.
I have used a split to remove the path name and the extension but cant get it to check.
I apologise for the messiness of the code. Been trying to get it sorted then Ill tidy it up. There is more code but that isnt required for this as I want it to run that code if there isnt a match.
Please can you help?
Sub sort_it_out()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim filnam As Variant
On Error GoTo errorhandler
Set wb1 = ActiveWorkbook
ChDir Application.ActiveWorkbook.path
'get files
filnam = Application.GetOpenFilename(FileFilter:="2D Table Formats (*.htm;*.xlsm;*.html),*.htm;*.xlsm;*.html", Title:="Select 2D Table", MultiSelect:=True)
'set the array
If IsArray(filnam) Then 'if at least one file is selected, this will be an Array
'define j as the array
For j = LBound(filnam) To UBound(filnam)
'remove path and extension
Dim s As String, a() As String, p As String
s = filnam(j)
a() = Split(s, "\")
p = Split(a(UBound(a)), ".")(0)
MsgBox "p " & p
'check if worksheet exists
For Each ws_check In ThisWorkbook.Worksheets()
If ws_check.Name = p Then
MsgBox "Its there"
Exit Sub
Else
End If
Next ws_check
'continue code from here
This then runs the code... but its not looping the array for some reason. Only one file at at a time. Can you please help?
It is a little hard to follow your code but does this do what you are trying to do?
I think you were storing the file name in the p variable so my code below would check each worksheet in the workbook to see if they have the same name as the p variable.
Public Sub CompareWorksheetNamesToFiles()
Dim file_name As String
file_name = ActiveWorkbook.Name
Dim ws_check As Worksheet
For Each ws_check In ThisWorkbook.Worksheets()
If ws_check.Name = p Then
Debug.Print ("Do Something")
End If
Next ws_check
End Sub
I have worked it all out now.
This will now open file locations, shorten their paths to just the filename minus the extension, then ws check checks the sheets against the filename and then looper jumps to the next.
Thank you to alwaysdata for helping me out.
Sub sort_it_out()
Dim filnam As Variant
'open file locations
filnam = Application.GetOpenFilename(FileFilter:="2D Table Formats (*.htm;*.xlsm;*.html),*.htm;*.xlsm;*.html", Title:="Select 2D Table", MultiSelect:=True)
'if at least one file is selected, this will be an Array
If IsArray(filnam) Then
For j = LBound(filnam) To UBound(filnam)
'remove pathway and extension from entire filename and path. ie C:\open.txt becomes open.
Dim s As String, a() As String, p As String
s = filnam(j)
a() = Split(s, "\")
p = Split(a(UBound(a)), ".")(0)
'check if worksheet exists against p ... ie if theres a worksheet called open it will goto the next option if not it will continue through code
For Each ws_check In ThisWorkbook.Worksheets()
If ws_check.Name = p Then
MsgBox p & " has already been transfered across. ", vbExclamation 'lets the user know this is already there.
GoTo looper
Else
End If
Next ws_check
'do something here with the code if not found. IE MSGBOX " NOT FOUND "
'jump to this point if there is a match.
looper:
Next
Else
Exit Sub
End If
End Sub
Simplified Excel Code:
Public MyFile As String
Public varSheetA As Variant
Public SelRangeA As Range
Public wsCopy As Excel.Worksheet
Sub SelectFile_Click()
MyFile = Application.GetOpenFilename() 'Aquire filepath from user
If (MyFile <> "False") Then
Range("B1").Value = "File Found"
End If
End Sub
Sub LoadFile_Click()
Dim WbOne As Workbook
Dim strRangeToCheck As String
strRangeToCheck = "A1:T2000"
Set WbOne = Workbooks.Open(MyFile) 'Open that file
Set wsCopy = WbOne.Worksheets(1) 'Try to copy
Set varSheetA = wsCopy.Range(strRangeToCheck) 'Try to copy
Set SelRangeA = wsCopy.Range(strRangeToCheck) 'Try to copy
WbOne.Close 'This is where we lose the references & values
End Sub
Sub DisplayFile_Click()
Range("A4").Value = varSheetA(1, 1)
End Sub
The end result of this program is to have the values from WorkSheet(1) in a Range or Variant Array so that I can edit and display them as needed and eventually copy the values back into the original file. However when I run this code, all the Public variables I initialize are empty when LoadFile_Click exits (more specifically when WbOne closes.
Previously my code looked like varSheetA = WbOne.Worksheet(1).Range(strRangeToCheck) although I'm currently in the process of testing different methods because that way didn't seem to work.
Anyone see any fundamental problems with what I'm trying to do? Thanks!
Option Explicit
Public MyFile As String
Public varSheetA As Variant
Sub SelectFile_Click()
MyFile = Application.GetOpenFilename() 'Aquire filepath from user
If (MyFile <> "False") Then
Range("B1").Value = "File Found"
End If
End Sub
Sub LoadFile_Click()
Const strRangeToCheck As String = "A1:T2000"
With Workbooks.Open(MyFile)
varSheetA = .Worksheets(1).Range(strRangeToCheck).Value
.Close False
End With
End Sub
Sub DisplayFile_Click()
Range("A4").Value = varSheetA(1, 1)
End Sub
I have a folder C:\test\ that has multiple .txt files which I need to append to one output text file. Using FSO and TextStream I can write the files explicitly with no problem in this manner:
Public Sub test()
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Const Path As String = "C:\test\"
Dim helloWorld As Object
Set helloWorld = FSO.CreateTextFile(FileName:=(Path & "helloworld.txt"), OverWrite:=True, Unicode:=False)
helloWorld.WriteLine FSO.GetFile("C:\test\Product_ID_update.txt").OpenAsTextStream(ForReading).ReadAll
helloWorld.WriteLine FSO.GetFile("C:\test\RPT-4475.txt").OpenAsTextStream(ForReading).ReadAll
helloWorld.Close
End Sub
It works perfectly, but I have hundreds of files to append so it would be crazy to type them all out, so I wrote some code to put all the file names into an array, then loop over each index to generate the file path. Here is the code:
Sub Combine_Text_Files2()
Dim InputDirPath As String
InputDirPath = "C:\test\"
Dim InputFileType As String
InputFileType = "*.txt"
Dim OutputDirPath As String
OutputDirPath = "C:\test\"
Dim OutputFileName As String
OutputFileName = "_CombinedOutput.txt"
Dim InputFileName As String
InputFileName = Dir$(InputDirPath & InputFileType)
Dim FileArray() As String
Dim i As Integer: i = 0
Do Until InputFileName = vbNullString
ReDim Preserve FileArray(0 To i)
FileArray(i) = InputFileName
InputFileName = Dir$
i = i + 1
Loop
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim Stream As Object
Set Stream = FSO.CreateTextFile((OutputDirPath & OutputFileName), OverWrite:=True, Unicode:=False)
Dim FileNameAndPath As String
For i = LBound(FileArray) To UBound(FileArray)
FileNameAndPath = (InputDirPath & FileArray(i))
Debug.Print ("Processing: " & FileNameAndPath)
Dim fileToCopy As File
Set fileToCopy = FSO.GetFile(FileNameAndPath)
Dim streamToCopy As TextStream
Set streamToCopy = fileToCopy.OpenAsTextStream(ForReading)
Dim text As String
text = streamToCopy.ReadAll
Stream.WriteLine FSO.GetFile(FileNameAndPath).OpenAsTextStream(ForReading).ReadAll
Debug.Print ("Appended to " & OutputFileName & ": " & FileNameAndPath)
Next i
Stream.Close
End Sub
The FileNameAndPath value gets updated correctly, and as it goes through the first Stream.WriteLine iteration, it appends only the first letter of the first file to the output file, then moves on to the next iteration, and on the next Stream.WriteLine it fails due to Invalid procedure call or argument.
I've been trying to debug this for quite a while but not certain what is causing this. Only thing I can think of that might be causing it is the array, because it's really the only thing that is different AFAIK... Any help would be greatly appreciated!
Additional details
If I comment out the WriteLine call it goes through the entire array, printing all file paths to immediate. As you can see I broke down the original one-liner into multiple steps for debugging.
Replicating it is easy:
Create a C:\test\ directory
Create two or more text files and add text content to each of them
Run the code in the VBE
I found the problem. The problem was not the code, it works fine (though I feel sure could be improved, I'll take it over to Code Review).
The problem was that some of the source files were actually originally Excel documents that became converted to .txt and apparently carried over some meta-data that Notepad ignored, but the VBA compiler did not know what to do with trying to put it into a String.
Lesson learned, perform a sanity check of your source data.
I wrote a windows form program in VB
In the from of my Project I want if a button is clicked, show a file (pdf or word) that save in database. I use this code for doing it and this code works fine. but files are copied in my bin folder of project. I want that these files only show on screen but not saved anywhere. Can anyone help me?
Try
Using dr As SqlDataReader = cmd.ExecuteReader()
While dr.Read()
Dim size As Integer = 1024 * 1024
Dim buffer As Byte() = New Byte(size - 1) {}
Dim readBytes As Integer = 0
Dim index As Integer = 0
filename = dr("DocName")
Using fs As New FileStream(filename, FileMode.Create, FileAccess.Write, FileShare.None)
While (InlineAssignHelper(readBytes, CInt(dr.GetBytes(0, index, buffer, 0, size)))) > 0
fs.Write(buffer, 0, readBytes)
index += readBytes
End While
End Using
End While
End Using
Catch ex As Exception
Dim errMessageBox As New Puzzle.ErrorHandler
errMessageBox.ShowError("Err", "FrmCustomer:DbTools_GetAttachFile", "line", ex.Message)
Exit Sub
Finally
ConImage.Close()
End Try
End Using
Dim prc As New Process()
prc.StartInfo.FileName = filename
prc.Start()
Just modify the following line, and it should work.
'filename = dr("DocName") ' replace this line
filename = IO.Path.GetTempFileName ' with this
Basically, IO.Path.GetTempFileName will get a temporary filename in the Windows Temp folder. This folder is used for keeping temporary files and is usually cleaned by various disk cleaning tools automatically or when you ask windows to reclaim wasted space (via Disk Cleanup program).
Note that you would need the same filename when opening the file.
I have a .dat file that just holds a list of names, each name is on a new line. How would I go about getting those names out of the file and putting them into a array?
you should read this
http://www.visualbasic.happycodings.com/Files_Directories_Drives/code54.html
Excerpt
Function FileLoadToArray(ByRef asLines() As String, ByVal sFileName As String) As String
Dim iFileNum As Long, lFileLen As Long
Dim sBuffer As String
'Initialise Variables
On Error GoTo ErrFailed
'Open File
iFileNum = FreeFile
Open sFileName For Binary Access Read As #iFileNum
'Get the size of the file
lFileLen = LOF(iFileNum)
If lFileLen Then
'Create output buffer
sBuffer = String(lFileLen, " ")
'Read contents of file
Get iFileNum, 1, sBuffer
'Split the file contents
asLines = Split(sBuffer, vbNewLine)
End If
Close #iFileNum
'Return success
FileLoadToArray = ""
Exit Function
ErrFailed:
Debug.Assert False
Debug.Print Err.Description
FileLoadToArray = Err.Description
'Close file
If iFileNum Then
Close #iFileNum
End If
End Function
My VB6 is a bit rusty but I would think it was something like this, thanks to Google! :P
DIM FileNo AS Integer
DIM strNameList() AS STRING
FileNo = FreeFile
Open "file.dat" For Input As FileNo
Do Until EOF(FileNo)
Line Input FileNo, strNameList(UBound(strNameList))
REDIM Preserve strNameList(UBound(strNameList) + 1)
Loop
Close FileNo
Now strNameList will have the array of entries from the file...Phew...I hope this is correct despite my rustic skills....
You can use a generic read-all-file function
Private Function ReadFile(sFile As String) As String
Dim nFile As Integer
nFile = FreeFile
Open sFile For Input Access Read As #nFile
ReadFile = Input$(LOF(nFile), nFile)
Close #nFile
End Function
with Split function like this
Dim vSplit As Variant
vSplit = Split(ReadFile("your_file.txt"), vbCrLf)