I am trying to copy multiple txt file into excel but having a little issue on the following:
Sub devise(FICHIER, FEUILLE)
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets(FEUILLE)
Dim wbcopy As Workbook
ChDir "R:\Oco_R\Valoco"
Workbooks.OpenText Filename:="R:\Oco_R\Valoco\" & FICHIER, Origin:= _
xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 1), Array(6, 1), Array(26, 1), Array(35, 1), Array(46, 1), _
Array(53, 1), Array(64, 1), Array(72, 1))
Selection.Copy
ws.Activate
ws.Range("A1").PasteSpecial
'ActiveSheet.Paste
ws.Rows("1:4").Delete Shift:=xlUp
ws.Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom
Application.CutCopyMode = False
ActiveWorkbook.Close
End Sub
I already defined the workbook where I would like the txt to be copied to. But I was wondering how I could DIM the txt file so that I can close it? For example FIHCIER.close, but doesn't work of course...
In the code I'm using ActiveWorkbook.Close but it is referring to my excel file which I don't want to close.
I tried using a Set wbC but haven't really succeeded...
Thank you very much for your help!
When you open a textfile using Workbooks.OpenText, Excel will create a workbook (containing one sheet) from the text file.
For some strange reasons OpenText is not implemented as function (in opposite to Workbooks.Open`), so you can't do something like
set txtFile = Workbooks.OpenText(MyTextFileName)
However, after you open the file, it is automatically the ActiveWorkbook, so you can do the following:
Dim txtFile as Workbook
Workbooks.OpenText filename:=MyTextFileName
Set txtFile = ActiveWorkbook
(...)
txtFile.close saveChanges:=False
Related
I am trying to succeed the following in VBA:
Open each file in the folder ( 1 by 1 )
Since all files are CSVs, I'd like to make them into more columns to gather the data I need.
I'd like to copy-paste these into one specific excel. These are around 300 rows.
In that specific Excel I'd like to have them pasted under each other.
What I have already tried:
The method to find all those files I need.
Make CSV datas into columns.
Copy-paste method.
Find the first empty row down under.
The problem is: I don't have enough knowledge for the macro to do it to all CSVs.
Please see my code below where I got so far:
Sub pm_logger()
Application.ScreenUpdating = False
Dim bookDest As Workbook
Dim bookFrom As Workbook
Dim lDestLastRow as Long
Dim sh As Worksheet
Workbooks.Open "P:\logs\logstorage.xlsx"
Workbooks.Open "P:\logs\logfile.csv"
Set bookDest = Workbooks("logstorage.xlsx")
Set bookFrom = Workbooks("logfile.csv")
bookFrom.Activate
Set sh = Worksheets(1)
With sh
Set Rng = .Range("A5:A305")
Set Rng = .Range(Rng, .Cells(.Rows.Count, Rng.Column).End(xlUp))
Rng.TextToColumns Destination:=Rng, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=True, _
Space:=False, _
Other:=False, _
FieldInfo:=Array(Array(1, xlGeneralFormat), Array(2, xlGeneralFormat), Array(3, xlGeneralFormat)), _
TrailingMinusNumbers:=True
End With
bookFrom.Worksheets(1).Range("A5:K304").Copy
lDestLastRow = bookDest.Cells(bookDest.Rows.Count, "A").End(xlUp).Offset(1).Row
bookDest.Range("A" & xlDestLastRow).PasteSpecial Paste:=xlPasteValues
'Workbooks("logstorage.xlsx").Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub
Thank you very much in advance!
To get this done, you first need a way to get all your .csv files loaded into your macro. This can be done a few ways, but I suggest a file picker to load them all into a collection:
Dim picker As Office.FileDialog
Dim mycsvs As New Collection
Dim file As Variant
Set picker = Application.FileDialog(msoFileDialogFilePicker)
With picker
.Filters.Clear
.Filters.Add "CSV files", "*.csv", 1
.AllowMultiSelect = True
.InitialFileName = "P:logs\"
If .Show = True Then
For Each file In .SelectedItems
mycsvs.Add file
Next file
End If
End With
Now you have the collection mycsvs which holds all the files you selected to be processed. Then all you need after that is to loop over them with the code you have already written:
Workbooks.Open "P:\logs\logstorage.xlsx"
For Each file In mycsvs
Set bookDest = Workbooks("logstorage.xlsx")
Set bookFrom = Workbooks.open(file)
'your code here from "Bookfrom.Activate"
bookFrom.Close SaveChanges:= False
Next file
'Workbooks("logstorage.xlsx").Close SaveChanges:=True
Heading ## I was able to get the selection to select active Cell a1 but now receive error 1004 Application Object-defined error, AT THE SECTION OF CODE <Sheets.Add before:=Workbooks(myFile).Sheets("Make DMS Report")>
Please see the code below.
The code filters the data from Agile export and filters the product Part number and associates the manufacture part number with the part.
'Start code
<Sub ImportAgileBOM()
'GoTo test1
Dim FullFileName As String
Dim myFile As String
Dim FileFormat As String
Dim rng As Range
'Open .cvs worksheet and convert to text format.
myFile = ActiveWorkbook.Name
FullFileName = Application.GetOpenFilename("Text files , *.csv; *.txt,Excel files (*.xls*), *.xls*", 2, "Select Agile Mfr BOM Report", , False)
If FullFileName = "False" Then
Application.DisplayAlerts = True
End
End If
'This section converts the .cvs and renames workboot to text
If Right(FullFileName, 4) = ".csv" Or Right(FullFileName, 4) = ".txt" Then
FileCopy FullFileName, FullFileName & "importtemp.txt"
FileFormat = "Text"
Workbooks.OpenText Filename:=FullFileName & "importtemp.txt", _
DataType:=xlDelimited, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=True, Space:=False, Other:=False, _
FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2))
Else
FileFormat = "Excel"
Workbooks.Open Filename:=FullFileName
End If
'Make Active Range
Set rng = ActiveSheet.Range("A1")
'Range("A1").Activate
If FileFormat = "Text" Then
If ActiveCell <> "Manufacturer BOM Report" Then
MsgBox "Input file not in Manufacturer BOM Report format"
ActiveWindow.Close
Application.DisplayAlerts = True
End
End If
ElseIf ActiveCell.Offset(0, 1) <> "Manufacturer BOM Report" Then
MsgBox "Input file not in Manufacturer BOM Report format"
ActiveWindow.Close
Application.DisplayAlerts = True
End
End If
'FullFileName = ActiveWorkbook.Name
'Sheets(ActiveSheet.Name).Copy Sheets.Add Sheet.before:=Workbooks(myFile).Sheets("Make DMS Report")
'Windows(FullFileName).Activate
'ActiveWindow.Close savechanges:=False
'Copy data to secound sheet
FullFileName = ActiveWorkbook.Name
Cells.Select
Selection.Copy
Workbooks(myFile).Activate
Sheets.Add before:=Workbooks(myFile).Sheets("Make DMS Report")
ActiveSheet.Paste>
'I receive the error when trying to add the created sheet to the Active sheet.
If you could assist in this issue it would be appreciated
I am now receiving an error at <Range("A1"). select> the error message is Run-time error 1004 Application-defined Or Object-defined error, I don't understand why I am receiving this error, just selecting a cell
I have an excel file that creates an order for our supplier, and I use a VBA script to copy the data to another file and format it in the manner the supplier uses. Now that is properly running, my boss wishes to use this method at our other locations. The problem is that the script is tailored to our local computer.
I need to change the path to the location the file saves in the script from our local drive:
C:\Users\*User*\Desktop\
to a generic one like this:
C:\Users\%USERNAME%\Desktop\
I've looked at several options but really am confused at the simplest manner of doing this properly.
Here is the code I am currently using:
Sub Order()
'
' Creates Order form Visual Basic control
' Visual Basic script recorded 8/27/2021 by Me
' Copies order to Supplier
'
MSG1 = MsgBox("Do you wish to create a new order?", vbYesNo, "New Order Confirmation")
If MSG1 = vbYes Then
'Copies data
Range("M1:N300").Select
Selection.Copy
Range("A3").Select
'Pastes data to text file
Workbooks.OpenText Filename:="C:\Users\*User*\Desktop\upload.txt", Origin:= _
437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
TrailingMinusNumbers:=True
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
Range("A3").Select
'Closes text file
Dim wb As Workbook
Set wb = Application.Workbooks.Open("C:\Users\*User*\Desktop\upload.txt")
wb.Close
End If
'Opens web upload dialog
MSG2 = MsgBox("Do you wish to upload the order to Supplier?", vbYesNo, "Upload Confirmation")
If MSG2 = vbYes Then
Const Hyper As String = "*URL of Supplier*"
ThisWorkbook.FollowHyperlink Address:=Hyper ', NewWindow:=Tru
End If
End Sub
I usually use the code on Ron de Bruins website.
Sub Test()
Dim WshShell As Object
Dim DeskTopPath As String
Set WshShell = CreateObject("WScript.Shell")
DeskTopPath = WshShell.SpecialFolders("Desktop")
Dim wrkBk As Workbook
Set wrkBk = Workbooks.Open(DeskTopPath & "\upload.txt")
wrkBk.Save
wrkBk.Close
End Sub
Special folders are : AllUsersDesktop, AllUsersStartMenu
AllUsersPrograms, AllUsersStartup, Desktop, Favorites
Fonts, MyDocuments, NetHood, PrintHood, Programs, Recent
SendTo, StartMenu, Startup, Templates
I've borrowed some code from a post on this site already and made my own. However I'm running into a problem where the multiple files in my folder path are importing OVER the previous import instead of below the created list.
What I'm trying to achieve is importing data from multiple files in a specific folder location. After pursing through each file, the next import data should be placed under the previous import data in the worksheet.
Any insights on how to fix?
Thanks so much!
cwegz
Option Explicit
Const FOLDER_PATH = "Test Folder Path/" 'REMEMBER END BACKSLASH
Sub ImportWorksheets()
'=============================================
'Process all Excel files in specified folder
'=============================================
Dim sFile As String 'file to process
Dim wsTarget As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim rowTarget As Long 'output row
rowTarget = 2
'check the folder exists
If Not FileFolderExists(FOLDER_PATH) Then
MsgBox "Specified folder does not exist, exiting!"
Exit Sub
End If
'reset application settings in event of error
On Error GoTo errHandler
Application.ScreenUpdating = False
'set up the target worksheet
Set wsTarget = Sheet1
'loop through the Excel files in the folder
sFile = Dir(FOLDER_PATH & "*.xls*")
Do Until sFile = ""
'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
Set wsSource = wbSource.Worksheets(1) 'EDIT IF NECESSARY
'import the data
With wsTarget
.Columns("A").Value = wsSource.Columns("A").Value 'this one works
.Columns("B").Value = wsSource.Columns("C").Value 'this one works
'.Range("A1" & rowTarget).Value = wsSource.Columns("A").Value
'.Range("B1" & rowTarget).Value = wsSource.Columns("C").Value
'optional source filename in the last column
.Range("N" & rowTarget).Value = sFile
End With
'close the source workbook, increment the output row and get the next file
wbSource.Close SaveChanges:=False
rowTarget = rowTarget + 1
sFile = Dir()
Loop
errHandler:
On Error Resume Next
Application.ScreenUpdating = True
'tidy up
Set wsSource = Nothing
Set wbSource = Nothing
Set wsTarget = Nothing
Set Selection = Nothing
Sheets("Pull").Select
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="#", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Set Selection = Nothing
Sheets("Pull").Select
Columns("D:D").Select
Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=";", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Set Selection = Nothing
Sheets("WhiteList").Select
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("K1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="#", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Set Selection = Nothing
Sheets("Summary").Select
End Sub
Here's one approach, which should work if your data tables are consistent and contain no blank rows/columns.
Option Explicit
Const FOLDER_PATH = "Test Folder Path\" 'REMEMBER END BACKSLASH
Sub ImportWorksheets()
Dim sFile As String 'file to process
Dim wsTarget As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet, rngData As Range, numRows As Long
Dim rowTarget As Long 'output row
If Not FileFolderExists(FOLDER_PATH) Then
MsgBox "Specified folder does not exist, exiting!"
Exit Sub
End If
On Error GoTo errHandler
Application.ScreenUpdating = False
Set wsTarget = Sheet1
'get first empty row, assuming colA always has values
rowTarget = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
sFile = Dir(FOLDER_PATH & "*.xls*")
Do Until sFile = ""
Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
Set wsSource = wbSource.Worksheets(1)
Set rngData = wsSource.Range("A1").CurrentRegion '<< assumes no empty rows/columns in your data table
numRows = rngData.Rows.Count '<<
With wsTarget
.Cells(rowTarget, "A").Resize(numRows, 1).Value = rngData.Columns(1).Value
.Cells(rowTarget, "B").Resize(numRows, 1).Value = rngData.Columns(3).Value
'etc etc
.Cells(rowTarget, "N").Value = sFile 'optional source filename in the last column
End With
wbSource.Close SaveChanges:=False
rowTarget = rowTarget + numRows '<<
sFile = Dir()
Loop
'snipped....
End Sub
I have 3 csv files which I have to merge and but before that I have to prepare then to have same columns order. All works fine except for I cannot figure out so far how change order of columns in output file. I can select columns which I want and other skips fine but what if I want to swap some? I thought that putting in proper order in fieldinfo array would do the trick but no. I want to swap 8 with 6.
Application.ScreenUpdating = False
Workbooks.OpenText Filename:=Filenamenew, Origin:=xlWindows, StartRow _
:=2, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 3), Array(2, 9), Array(3, 1), Array(4, 9), Array(5, 9), Array(8, 1), Array(7, 9), Array(6, 1))
Set Wb = ActiveWorkbook
Application.DisplayAlerts = False
Wb.SaveAs Filename:=LBname, FileFormat:=FileFormatNum, _
ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True
Wb.Close savechanges:=False
thanks
The best way to do this is to change the output of whatever is creating the CSV file you need to change. I assume you don't have access to that for whatever reason, so this will get the job done:
Sub swapColumns(first As Integer, second As Integer)
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Open("C:\root\test.csv")
Set ws = wb.Sheets(1)
If first > second Then
Dim i As Integer
i = first
first = second
second = i
ElseIf first = second Then
Exit Sub
End If
ws.Columns(second).Cut
ws.Columns(first).Insert Shift:=xlToRight
ws.Columns(first + 1).Cut
ws.Columns(second + 1).Insert Shift:=xlToRight
End Sub
You can call this Sub from your existing code with swapColumns 6, 8