Modifying CSV files from a local folder-VBA - excel

I am trying to rearrange the order of the columns in csv files in a folder on my local drive.
At the moment, from a tutorial, I have found a way to loop through the files. I wanted to cut a column and re insert in a different column. When running this code, Excel is crashing. It seems to be going through duplicate files.
I expected the columns to have moved in all the files in the folder. But they didn't move. And excel is crashing, looks like it's duplicating the files when hitting CTRL + G and running the code.
Here's the code.
Option Explicit
Sub FleetMoveColumns()
Dim fileDirectory As String
Dim fileCriteria As String
Dim fileName As String
Dim fileToOpen As Workbook
Application.ScreenUpdating = False
fileDirectory = "C:\...\*csv"
fileName = Dir(fileDirectory)
Do While Len(fileName) > 0
Set fileToOpen = Workbooks.Open(fileDirectory & fileName)
Columns("R").Cut
Columns("AB").Insert
Debug.Print fileName
Loop
Application.ScreenUpdating = True
End Sub
Please help.

You need to fully qualify your Columns object with a Worksheet object.
You need to place FileName = Dir within your Do While loop.
Modified code
Do While Len(FileName) > 0
Set fileToOpen = Workbooks.Open(fileDirectory & FileName)
' set the worksheet object
Set Sht = fileToOpen.Worksheets(1) ' <-- Rename "Sheet1" to your desired worksheet
With Sht
.Columns("R").Cut
.Columns("AB").Insert
End With
' clear objects
Set Sht = Nothing
Set fileToOpen = Nothing
Debug.Print FileName
FileName = Dir
Loop

Related

Why does my macro changes all my currency formatted cells in Excel?

I'm writing a macro to loop thru some excel-files, in a specific directory, to update some values in each file. The value to be updated is located on a worksheet which name is the same in every file. The worksheet I try to update is protected in every file. My problem is when I update those files (I only have to unprotect it) and save my changes, all cells (in entire workbook) that I have formatted as 'currency' or 'accounting' and which contain a formula will be formatted as 'Custom'. Can anyone help me out with this problem?
EDIT: If I stop my macro before closing the file (opened by the macro) and then save the updated file manually, all my formatted cells have the correct format when I open it again.
This is my simplest code I have tried:
Sub moveBill()
Dim ws As Worksheet
Dim rng As Range
Dim objFs As Object
Dim objFolder As Object
Dim file As Object
Dim folder As String
Dim fileCount As Integer
Dim pw As String
pw = "1234"
folder = "C:\Excel-test"
Set objFs = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFs.GetFolder(folder)
fileCount = 0
' Loop through all the files in the folder.
For Each file In objFolder.Files
If Left(file.Name, 12) <> "FINAL REPORT" Then
Dim src As Workbook ' The source workbook.
Set src = Workbooks.Open(file.Path, True)
Set ws = src.Worksheets("Fakturaunderlag")
Set rng = ws.Range("E1")
fileCount = fileCount + 1
ws.Unprotect pw
rng.value = 1
MsgBox "Go to next file"
src.Close (True)
Set src = Nothing
End If
Next
MsgBox fileCount & " files have been updated"
End Sub
This is before I run my code:
This is after I run my code:
This is the 'Custom' formatting that appears after update om my files:

How to get all contents from .TXT file maintaining leading "0"?

I have this code
Dim FileToOpen As Variant
Dim OpenBook As Workbook
FileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Sheets(1).UsedRange.Select
Selection.NumberFormat = "#"
OpenBook.Sheets(1).UsedRange.Copy
ThisWorkbook.Worksheets("BOM").Range("C1").PasteSpecial xlPasteValues
OpenBook.Close False
End If
Which is how I tried to automate manual actions of:
Opening a .txt file
Ctrl + a
Ctrl + c
Pasting it in my workbook via VBA code which is irrelevant in this case.
In the end I end up with this kind of table (main workbook in the image below has .NumberFormat = "#"):
https://i.stack.imgur.com/98tiC.png
But when I run it with the code above - I end up with:
https://i.stack.imgur.com/bJahk.png
Ignore the column titles in the row 1.
The problem I faced is that this code I have above, opens .txt file contents with already lost leading "0" in a temporary excel workbook from where it then copies them to my active workbook.
I'm wondering if there's any ways around it to get what I am looking to get done i.e. properly automating the sequence of manual actions listed above via VBA code displaying a search message box as it does now and then me choosing a .txt file I need and getting all the contents from it to my active workbook while maintaining all leading zeros (the number of zeroes and length of strings may vary so no solutions of adding them back in again won't be what I'm looking for)
The issue that you have is that as soon as excel gets hold of the data it creates problems.
So read it as a text file and split each line and output that directly to your target range - it will therefor stop excel parsing any strings as values - after that you can do whatever you want
option explicit
Sub read_text()
Dim FileToOpen As Variant
FileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
Dim max_cols As Long
max_cols = 0
Dim r_out As Range
Set r_out = ThisWorkbook.Worksheets("BOM").Range("C1")
Dim row_offset As Long
offset = 0
If FileToOpen <> False Then
Dim fso As Object
Dim file As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.OpenTextFile(FileToOpen, 1)
While Not file.AtEndOfStream
Dim line As String
line = file.ReadLine
Dim line_arr As Variant
line_arr = Split(line, vbTab)
ThisWorkbook.Worksheets("BOM").Range("C1").offset(row_offset, 0) _
.Resize(1, UBound(line_arr) - LBound(line_arr) + 1).Value = line_arr
row_offset = row_offset + 1
Wend
file.Close
End If
End Sub
output

Excel VBA: Copy data from multiple passwordprotected workbooks in a folder into one worksheet in another workboo

I have written a code that opens a password protected workbook in a folder, copy some values out of it and paste the values in active woorkbook. This works fine.
My problem is that I have 16 password protected files in this folder, and I need a loop that does the same thing with every file. Below you can find the code, and I think all my problems should be properly explained with comments inside the code. Please ask if anything is unclear. In advance, thanks for any help!
Code:
Sub Bengt()
Dim sPath As String
Dim vFolder As Variant
Dim sFile As String
Dim sDataRange As String
Dim mydata As String
Dim wb As Workbook
Dim WBookOther As Workbook
Dim myArray As Variant '<<does the list of passwords have to be array?
sPath = ThisWorkbook.Path & Application.PathSeparator
sDataRange = "Budsjett_resultat'!E2" '<<every file I want to open has data in this sheet and range
sFile = "BENGT.xlsm" '<< how to make sFile be every file in folder?
' here I want a loop that opens every woorkbook in the folder M::\SALG\2016\Budsjett\
Set WBookOther = Workbooks.Open(sPath & sFile, Password:="bengt123")
' all passwords starts with filename + three numbers after as you can see
' here I want to make excel find the password out of a list of passwords in range B100:B116
mydata = "='" & sPath & "[" & sFile & "]" & sDataRange
'mydata = "='M:\SALG\2016\Budsjett\Bengt.xlsmBudsjett_resultat'!E2:E54" '<< change as required
'link to worksheet
With ThisWorkbook.Worksheets(1).Range("T2:T54")
'in this case I want the loop to find "BENGT"(which is the filename) in cell T1, and paste the values in range T2:T54.
'For the other files, I want the loop to find the filename (of the file it opened) in row 1,
'and paste the values in range ?2-?54 at the column with the same name as the filename
.Formula = mydata
.Value = .Value
WBookOther.Close SaveChanges:=False
End With
End Sub
For the password array I have tried following code:
Sub passord()
Dim myArray As Variant
myArray = ThisWorkbook.Worksheets(1).Range("B100:B116")
On Error Resume Next 'turn error reporting off
For i = LBound(myArray, 1) To UBound(myArray, 1)
Set wb = Workbooks.Open("M:\SALG\2016\Budsjett\BENGT.xlsm", Password:=myArray(i, 1))
If Not wb Is Nothing Then bOpen = True: Exit For
Next i
End Sub
I have tried to implement the last sub into the first sub, but I can't figure out how to make it work.

VBA Excel - Faster Execute - Copy Sheet (with charts/objects) from closed file

I am hoping to find a way to help this code run faster; so this is the path im following to try and achieve this -
current time - 23 seconds, most of it opening & closing files.
So I am attempting to pull data from files without opening them.
I've seen Microsoft.ACE.OLEDB.12.0 but I have not idea how to use it to get the entire sheet, warts and all.
I've seen a lot of solutions that pull data from cells and gets sheet names -
I want my entire sheet, all objects on that sheet, its headers, footers, everything.
This is the macro I'd like to apply it to:
Sub DirPDF_Long_Sections(LongFolderPath As String)
' ####################################################################################
' # INTRO
'-------------------------------------------------------------------------------------
' Purpose
' This procedure assists the user to put all long sections from a folder into one
' PDF file. This makes it convieniet to share the long sections & print them.
'
' THIS PROCEDURE USES DIR instead of FSO
'
' ####################################################################################
' # DECLAIRATIONS
'-------------------------------------------------------------------------------------
' OBJECTS
Dim LongFolder As String
Dim LongFile As String
Dim OpenLong As Workbook
Dim ExportWB As Workbook
'Dim FileSystemObj As New FileSystemObject
'-------------------------------------------------------------------------------------
' VARIABLES
Dim count As Long
Dim DefaultPrinter As String
Dim DefaultSheets As Variant
Dim FirstSpace As Long
Dim LastSpace As Long
Dim start_time, end_time
' ####################################################################################
' # PROCEDURE CODE
'-------------------------------------------------------------------------------------
' optimise speed
start_time = Now()
Application.ScreenUpdating = False
'-------------------------------------------------------------------------------------
' Print the Files in the Folder:
DefaultSheets = Application.SheetsInNewWorkbook '// save default setting
Application.SheetsInNewWorkbook = 1 '// create a one worksheet workbook
Set ExportWB = Workbooks.Add
Application.SheetsInNewWorkbook = DefaultSheets '// re-set application to default
LongFile = Dir(LongFolderPath & "\*PipeLongSec*", vbNormal)
While LongFile <> vbNullString '// loop through all the files in the folder
FirstSpace = InStr(1, LongFile, " ") '// record position of first space character
LastSpace = InStr(FirstSpace + 1, LongFile, " ") '// record position of last space character
Set OpenLong = Workbooks.Open(LongFile) '// open the file
OpenLong.Sheets("Long Sections").Copy After:=ExportWB.Sheets(ExportWB.Sheets.count)
'// copy sheet into export workbook
ExportWB.Sheets(ExportWB.Sheets.count).Name = Mid(LongFile, FirstSpace + 1, LastSpace - FirstSpace - 1)
'// rename sheet we just moved to its pipe number
OpenLong.Close '// close the file
LongFile = Dir() '// get next file
Wend
'-------------------------------------------------------------------------------------
' Delete the other worksheet in the temporary workbook
Application.DisplayAlerts = False
ExportWB.Sheets("Sheet1").Delete
Application.DisplayAlerts = True
'-------------------------------------------------------------------------------------
' Send Workbook to PDF - in save location
ExportWB.ExportAsFixedFormat xlTypePDF, LongFolderPath & "\" & "LongSectionCollection " & Replace(Date, "/", "-")
ExportWB.Close SaveChanges:=False
'#####################################################################################
'# END PROCEDURE
Application.ScreenUpdating = True
Set OpenLong = Nothing
end_time = Now()
MsgBox (DateDiff("s", start_time, end_time))
End Sub
Add Option Explicit before any code at the top
Convert DefaultSheets to CLngPtr(DefaultSheets)
Convert Long data types to CLngPtr(variable)
Convert to CDate(Start_Time)
Convert to CDate(End_Time)
No worries. They should be defined in the dim statement if they would remain the same data type. If this data type changes throughout the code then use as variant in the dim statement and use the conversion functions found in the object browser to convert the data types as needed.

copy a sheet from a workbook without opening to another [duplicate]

I want to collect data from different files and insert it into a workbook doing something like this.
Do While THAT_DIFFERENT_FILE_SOMEWHERE_ON_MY_HDD.Cells(Rand, 1).Value <> "" And Rand < 65536
then 'I will search if the last row in my main worksheet is in this file...
End Loop
If the last row from my main worksheet is in the file, I'll quit the While Loop. If not, I'll copy everything. I'm having trouble finding the right algorithm for this.
My problem is that I don't know how to access different workbooks.
The best (and easiest) way to copy data from a workbook to another is to use the object model of Excel.
Option Explicit
Sub test()
Dim wb As Workbook, wb2 As Workbook
Dim ws As Worksheet
Dim vFile As Variant
'Set source workbook
Set wb = ActiveWorkbook
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xls", _
1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile
'Set targetworkbook
Set wb2 = ActiveWorkbook
'For instance, copy data from a range in the first workbook to another range in the other workbook
wb2.Worksheets("Sheet2").Range("C3:D4").Value = wb.Worksheets("Sheet1").Range("A1:B2").Value
End Sub
You might like the function GetInfoFromClosedFile()
Edit: Since the above link does not seem to work anymore, I am adding alternate link 1 and alternate link 2 + code:
Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
GetInfoFromClosedFile = ""
If Right(wbPath, 1) <> "" Then wbPath = wbPath & ""
If Dir(wbPath & "" & wbName) = "" Then Exit Function
arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function
Are you looking for the syntax to open them:
Dim wkbk As Workbook
Set wkbk = Workbooks.Open("C:\MyDirectory\mysheet.xlsx")
Then, you can use wkbk.Sheets(1).Range("3:3") (or whatever you need)
There's very little reason not to open multiple workbooks in Excel. Key lines of code are:
Application.EnableEvents = False
Application.ScreenUpdating = False
...then you won't see anything whilst the code runs, and no code will run that is associated with the opening of the second workbook. Then there are...
Application.DisplayAlerts = False
Application.Calculation = xlManual
...so as to stop you getting pop-up messages associated with the content of the second file, and to avoid any slow re-calculations. Ensure you set back to True/xlAutomatic at end of your programming
If opening the second workbook is not going to cause performance issues, you may as well do it. In fact, having the second workbook open will make it very beneficial when attempting to debug your code if some of the secondary files do not conform to the expected format
Here is some expert guidance on using multiple Excel files that gives an overview of the different methods available for referencing data
An extension question would be how to cycle through multiple files contained in the same folder. You can use the Windows folder picker using:
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .Selected.Items.Count = 1 the InputFolder = .SelectedItems(1)
End With
FName = VBA.Dir(InputFolder)
Do While FName <> ""
'''Do function here
FName = VBA.Dir()
Loop
Hopefully some of the above will be of use
I had the same question but applying the provided solutions changed the file to write in. Once I selected the new excel file, I was also writing in that file and not in my original file. My solution for this issue is below:
Sub GetData()
Dim excelapp As Application
Dim source As Workbook
Dim srcSH1 As Worksheet
Dim sh As Worksheet
Dim path As String
Dim nmr As Long
Dim i As Long
nmr = 20
Set excelapp = New Application
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
.Show
path = .SelectedItems.Item(1)
End With
Set source = excelapp.Workbooks.Open(path)
Set srcSH1 = source.Worksheets("Sheet1")
Set sh = Sheets("Sheet1")
For i = 1 To nmr
sh.Cells(i, "A").Value = srcSH1.Cells(i, "A").Value
Next i
End Sub
With excelapp a new application will be called. The with block sets the path for the external file. Finally, I set the external Workbook with source and srcSH1 as a Worksheet within the external sheet.

Resources