Related
I have tried writing my own VBA code, everything and all files work great. However, I do have these 4 files that are converted to respective columns but in the file explorer, it's not shown as an excel workbook.
I've tried using fileformat 51, which gave me the same result, so I'm not sure where have gone wrong, please assist. Thanks in advance
Here is my code:
Sub CSVtoXlsx()
Do While fname <> ""
Dim wb As Workbook
Dim mydata As String, temparray() As String, strdata() As String
Dim i As Integer
Set wb = Workbooks.Add
csvfilepath = csvfolder & fname
Open csvfilepath For Binary As #1
mydata = LOF(1)
Get #1, , mydata
Close #1
strdata() = Split(mydata, vbCrLf)
temparray() = Split(strdata(0), "|")
ReDim arcol(0 To UBound(temparray))
For i = 0 To UBound(temparray)
arcol(i) = 2
Next i
With wb.Sheets(1).QueryTables.Add( _
Connection:="text;" & csvfilepath, Destination:=wb.Sheets(1).Range("a1"))
.Name = "formatted_data"
.FieldNames = True
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType= xlDelimited
.TextFileTextQualifier = xlTextQualifierNone
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = arcol
.Refresh BackgroundQuery:=False
End With
Application.DisplayAlerts = False
wb.SaveAs (xlsfolder & fname & ".xlsx"), xlOpenXMLWorkbook
Application.DisplayAlerts = True
wb.Close savechanges:=False
fname = Dir
In order to eliminate csv extension, please replace:
wb.SaveAs (xlsfolder & fname & ".xlsx"), xlOpenXMLWorkbook
with:
wb.SaveAs (xlsfolder & Split(fname, ".")(0) & ".xlsx"), xlOpenXMLWorkbook
I have txt files that are automatically exported to me from another system (I cannot change this system). When I try to convert these txt files to excel with the following code (I created a subfolder xlsx manually):
Sub all()
Dim sourcepath As String
Dim sDir As String
Dim newpath As String
sourcepath = "C:\Users\PC\Desktop\Test\"
newpath = sourcepath & "xlsx\"
'make sure subfolder xlsx was created before
sDir = Dir$(sourcepath & "*.txt", vbNormal)
Do Until Len(sDir) = 0
Workbooks.Open (sourcepath & sDir)
With ActiveWorkbook
.SaveAs Filename:=Replace(Left(.FullName, InStrRev(.FullName, ".")), sourcepath, newpath) & "xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
.Close
End With
sDir = Dir$
Loop
End Sub
it does work, however certain special characters, like ä,ö and Ü and so, are not properly displayed. I.e. when I open the xlsx files later on, I can see that these have been replaced by something like ä and so. I could use a work around and now start to replace these afterwards, however I would like to improve my txt to xlsx code. According to this post or this one it should be possible using ADODB.Stream. However, I don't know how to implement this into my code (loop) to get it working here in my case? If there is another approach instead of ADOB.Stream I am also fine with that. It is not necessary for me to use ADOB.Stream.
Have you tried coercing the code page, using the Origin parameter? I don't know if you need a particular one, but the UTF-8 constant might be a starting point. I personally like this page as a reference source: https://learn.microsoft.com/en-us/windows/win32/intl/code-page-identifiers
So the solution might turn out to be as simple as this - it worked in my dummy tests:
Option Explicit
Private Const CP_UTF8 As Long = 65001
Public Sub RunMe()
Dim sDir As String, sourcePath As String, fileName As String
Dim fso As Object
sourcePath = "C:\anyoldpath\"
Set fso = CreateObject("Scripting.FileSystemObject")
sDir = Dir(sourcePath & "*.txt", vbNormal)
Do While Len(sDir) > 0
fileName = sourcePath & "xlsx\" & fso.GetBaseName(sDir) & ".xlsx"
Application.Workbooks.OpenText sourcePath & sDir, CP_UTF8
ActiveWorkbook.SaveAs fileName, xlOpenXMLWorkbook
ActiveWorkbook.Close False
sDir = Dir()
Loop
End Sub
Assuming that these txt files are tab delimited.
The handling of the characters or code page it's managed by the Origin parameter of the Workbooks.OpenText method or by the TextFilePlatform property of the QueryTable object.
These txt files should be opened with Workbooks.OpenText method, however in order to handle problem of the Decimal.Separator been different than then one in your system, I suggest to use the QueryTable method also applied to the tab separated files with a csv extension.
We just need to replace these lines:
sFile = Dir$(sPathSrc & "*.csv")
sFilenameTrg = sPathTrg & Left(sFile, InStrRev(sFile, ".csv")) & "xlsx"
With these:
sFile = Dir$(sPathSrc & "*.txt")
sFilenameTrg = sPathTrg & Left(sFile, InStrRev(sFile, ".txt")) & "xlsx"
No changes to Procedure `Open_Csv_As_Tab_Delimited_Then_Save_As_Xls, perhaps a change in the name to reflect its versatility.
Tested with this tst file:
Generated this `xlsx' file:
Hopefully, it should be straightforward to add these procedure to you project, let me know of any problem or question you might have with the resources used.
Sub Tab_Delimited_UTF8_Files_Save_As_Xlsx()
Dim sFilenameSrc As String, sFilenameTrg As String
Dim sPathSrc As String, sPathTrg As String
Dim sFile As String
Dim bShts As Byte, exCalc As XlCalculation
sPathSrc = "C:\Users\PC\Desktop\Test\"
sPathTrg = sPathSrc & "xlsx\"
Rem Excel Properties OFF
With Application
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
exCalc = .Calculation
.Calculation = xlCalculationManual
.CalculateBeforeSave = False
bShts = .SheetsInNewWorkbook
.SheetsInNewWorkbook = 1
End With
Rem Validate Target Folder
If Len(Dir$(sPathTrg, vbDirectory)) = 0 Then MkDir sPathTrg
Rem Process Csv Files
sFile = Dir$(sPathSrc & "*.txt")
Do Until Len(sFile) = 0
sFilenameSrc = sPathSrc & sFile
sFilenameTrg = sPathTrg & Left(sFile, InStrRev(sFile, ".txt")) & "xlsx"
Call Open_Csv_As_Tab_Delimited_Then_Save_As_Xls(sFilenameSrc, sFilenameTrg)
sFile = Dir$
Loop
Rem Excel Properties OFF
With Application
.SheetsInNewWorkbook = bShts
.Calculation = exCalc
.CalculateBeforeSave = True
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
End Sub
…
Sub Open_Txt_As_Tab_Delimited_Then_Save_As_Xls(sFilenameSrc As String, sFilenameTrg As String)
Dim Wbk As Workbook
Rem Workbook - Add
Set Wbk = Workbooks.Add(Template:="Workbook")
With Wbk
Rem Txt File - Import
With .Worksheets(1)
Rem QueryTable - Add
With .QueryTables.Add(Connection:="TEXT;" & sFilenameSrc, Destination:=.Cells(1))
Rem QueryTable - Properties
.SaveData = True
.TextFileParseType = xlDelimited
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = ","
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileTrailingMinusNumbers = True
.TextFilePlatform = 65001 'Unicode (UTF-8)
.Refresh BackgroundQuery:=False
Rem QueryTable - Delete
.Delete
End With: End With
Rem Workbook - Save & Close
.SaveAs Filename:=sFilenameTrg, FileFormat:=xlOpenXMLWorkbook
.Close
End With
End Sub
I have tab separated csv files which I want to transform to xlsx. So each csv should be transformed to a xlsx. Filename should be the same. However, the files are tab separated. For example, see this test file screenshot:
When I run my code (I created a subfolder xlsx before):
Sub all()
Dim sourcepath As String
Dim sDir As String
Dim newpath As String
sourcepath = "C:\Users\PC\Desktop\Test\"
newpath = sourcepath & "xlsx\"
'make sure subfolder xlsx was created before
sDir = Dir$(sourcepath & "*.csv", vbNormal)
Do Until Len(sDir) = 0
Workbooks.Open (sourcepath & sDir)
With ActiveWorkbook
.SaveAs Filename:=Replace(Left(.FullName, InStrRev(.FullName, ".")), sourcepath, newpath) & "xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
.Close
End With
sDir = Dir$
Loop
End Sub
it does work, but when I look into the excel file:
I can see that the tab separator was not detected. I think my local settings are that the separator is a semi-colon and that's why it is not working. Now I wanted to set dataType to xlDelimited and tab to True, with changing the one line to:
Workbooks.Open (Spath & sDir), DataType:=xlDelimited, Tab:=True
I also tried
Workbooks.Open (Spath & sDir, DataType:=xlDelimited, Tab:=True)
or
Workbooks.Open FileName:=Spath & sDir, DataType:=xlDelimited, Tab:=True
But this leads to an error message. I then tried another approach, where I set the delimiter to Chr(9) (tab) and local to false:
Sub all()
Dim wb As Workbook
Dim strFile As String
Dim strDir As String
strDir = "C:\Users\PC\Desktop\Test\"
strFile = Dir(strDir & "*.csv")
Do While strFile <> ""
Set wb = Workbooks.Open(Filename:=strDir & strFile, Delimiter:=Chr(9), Local:=False)
With wb
.SaveAs Replace(wb.FullName, ".csv", ".xlsx"), 51
.Close True
End With
Set wb = Nothing
strFile = Dir
Loop
End Sub
It does not lead to an error. But when I open the file, it looks like:
So again same problem, the tab separator is not recognized. How can I fix this?
(I also tried it with local:True together with Delimiter:=Chr(9), but same problem and I also tried it with adding Format:=6)
I tried it this way with csv as I did not want to go the same way with txt file extension. Reason is that using csv easily allows special language characters like "ö" and "ü". So that is why I wanted to convert csv to xlsx and not use the workaround of using txt instead, as I then run into the problem that when I try to convert txt to xlsx certain special characters are not properly recognised and I hope to avoid this problem with using csv.
The csv (or actually these are tsv, because they have the tab as separator and not semi-colon) files have different columns. So could be one csv file has 5 columns, the other 6 and the datatypes vary too.
EDIT:
In repsonse to EEMs answer:
Check this Test.csv file, it looks like this:
Separated by tab. Not semi-colon.
When I run the code (plus adding .TextFileDecimalSeparator = "." to the code) and check the resulting xlsx file it looks like this:
Values in the second column (ColumnÄ), like 9987.5 are correctly transformed to 9987,5. But values in the last column (ColumnI) are wrongly transformed. This is my problem now. (I dont know why special character does not get transformed correctly, as in my original files this does work.)
As mentioned by #RonRosenfeld, files with .csv extension will be opened by excel as a text file with tab delimiters.
Also the following assumption is not accurate:
Option1 txt is not a way for me, as I face a new problem that UTF-8
special characters, like äö and so are not properly imported.
The handling of the characters or code page has nothing to do with the extension of the files, instead it's managed by the Origin parameter of the Workbooks.OpenText method or by the TextFilePlatform property of the QueryTable object.
Therefore unless the files are renamed with a extension different than csv the [Workbooks.OpenText method] will not be effective.
The solution proposed below, uses the QueryTable object and consist of two procedures:
Tab_Delimited_UTF8_Files_Save_As_Xlsx
Sets the source and target folder
Creates the xlsx folder if not present
Gets all csv files in the source folder
Open_Csv_As_Tab_Delimited_Then_Save_As_Xls
Process each csv files
Adds a workbook to hold the Query Table
Imports the csv file
Deletes the Query
Saves the File as `xlsx'
EDIT I These lines were added to ensure the conversion of the numeric data:
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = ","
EDIT II A Few changes to rename the worksheet (marked as '# )
Tested with this csv file:
Generated this `xlsx' file:
Hopefully, it should be straightforward to add these procedure to you project, let me know of any problem or question you might have with the resources used.
Sub Tab_Delimited_UTF8_Files_Save_As_Xlsx()
Dim sFile As String
Dim sPathSrc As String, sPathTrg As String
Dim sFilenameSrc As String, sFilenameTrg As String
Dim bShts As Byte, exCalc As XlCalculation
Rem sPathSrc = "C:\Users\PC\Desktop\Test\"
sPathTrg = sPathSrc & "xlsx\"
Rem Excel Properties OFF
With Application
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
exCalc = .Calculation
.Calculation = xlCalculationManual
.CalculateBeforeSave = False
bShts = .SheetsInNewWorkbook
.SheetsInNewWorkbook = 1
End With
Rem Validate Target Folder
If Len(Dir$(sPathTrg, vbDirectory)) = 0 Then MkDir sPathTrg
Rem Process Csv Files
sFile = Dir$(sPathSrc & "*.csv")
Do Until Len(sFile) = 0
sFilenameSrc = sPathSrc & sFile
sFile = Left(sFile, -1 + InStrRev(sFile, ".csv")) '#
sFilenameTrg = sPathTrg & sFile & ".xlsx" '#
Call Open_Csv_As_Tab_Delimited_Then_Save_As_Xls(sFile, sFilenameSrc, sFilenameTrg) '#
sFile = Dir$
Loop
Rem Excel Properties OFF
With Application
.SheetsInNewWorkbook = bShts
.Calculation = exCalc
.CalculateBeforeSave = True
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
End Sub
…
Sub Open_Csv_As_Tab_Delimited_Then_Save_As_Xls(sWsh As String, sFilenameSrc As String, sFilenameTrg As String) '#
Dim Wbk As Workbook
Rem Workbook - Add
Set Wbk = Workbooks.Add
With Wbk
With .Worksheets(1)
Rem QueryTable - Add
With .QueryTables.Add(Connection:="TEXT;" & sFilenameSrc, Destination:=.Cells(1))
Rem QueryTable - Properties
.SaveData = True
.TextFileParseType = xlDelimited
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = ","
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileTrailingMinusNumbers = True
.TextFilePlatform = 65001 'Unicode (UTF-8)
.Refresh BackgroundQuery:=False
Rem QueryTable - Delete
.Delete
End With
Rem Rename Worksheet '#
On Error Resume Next '# Ignore error in case the Filename is not valid as Sheetname
.Name = sWsh '#
On Error GoTo 0 '#
End With
Rem Workbook - Save & Close
.SaveAs Filename:=sFilenameTrg, FileFormat:=xlOpenXMLWorkbook
.Close
End With
End Sub
With a delimited file that has a csv extension, Excel's Open and vba Workbooks.Open and Workbooks.OpenText methods will always assume that the delimiter is a comma, no matter what you put into the argument.
You can change the file extension (eg to .txt), and then the .Open method should work.
You could read it into a TextStream object and parse it line by line in VBA
You can Import the file rather than Opening the file.
You could use Power Query to import it.
Or you could use a variation of the code below, which was just generated by the macro recorder, so you'll have to clean it up and adapt it a bit to your specifics.
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;D:\Users\Ron\Desktop\myFile.csv", Destination:=Range("$A$12"))
.CommandType = 0
.Name = "weather_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
This method uses File System Object and Text Stream to change from tab delimited to comma delimited. Select Microsoft Scripting Runtime inside of Tools/References to make available the library used. If semicolon delimited also does not open correctly, you can replace third parameter of REPLACE function in line fileContents = Replace(fileContents, vbTab, ";") with comma and try again. Note we are creating a .csv file with Set textStreamObj = fileSystemObj.CreateTextFile("filePath2.csv"), not overwriting our original.
Option Explicit
Sub changeDelimitedMarker()
Dim fileSystemObj As Scripting.FileSystemObject
Dim textStreamObj As Scripting.TextStream
Dim fileContents As String
Set fileSystemObj = New FileSystemObject
Set textStreamObj = fileSystemObj.OpenTextFile("filePath1.csv")
fileContents = textStreamObj.ReadAll
textStreamObj.Close
fileContents = Replace(fileContents, vbTab, ",")
Set textStreamObj = fileSystemObj.CreateTextFile("filePath2.csv")
textStreamObj.Write fileContents
textStreamObj.Close
End Sub
Using the ADODB.Stream object, you can create a user-defined function.
Sub all()
Dim sourcepath As String
Dim sDir As String
Dim newpath As String
Dim vResult As Variant
Dim Wb As Workbook
Dim Fn As String
sourcepath = "C:\Users\PC\Desktop\Test\"
newpath = sourcepath & "xlsx\"
'make sure subfolder xlsx was created before
sDir = Dir$(sourcepath & "*.csv", vbNormal)
Application.ScreenUpdating = False
Do Until Len(sDir) = 0
'Workbooks.Open (sourcepath & sDir)
'use adodb.stream
vResult = TransToTextWithCsvUTF_8(sourcepath & sDir)
Fn = Replace(sDir, ".csv", ".xlsx")
Set Wb = Workbooks.Add
With Wb
Range("a1").Resize(UBound(vResult, 1) + 1, UBound(vResult, 2) + 1) = vResult
.SaveAs Filename:=newpath & Fn, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
.Close
End With
sDir = Dir$
Loop
Application.ScreenUpdating = True
End Sub
Function TransToTextWithCsvUTF_8(strFn As String) As Variant
Dim vR() As String
Dim i As Long, r As Long, j As Integer, c As Integer
Dim objStream As Object
Dim strRead As String
Dim vSplit, vRow
Dim s As String
Set objStream = CreateObject("ADODB.Stream")
With objStream
.Charset = "utf-8"
.Open
.LoadFromFile strFn
strRead = .ReadText
.Close
End With
vSplit = Split(strRead, vbCrLf)
r = UBound(vSplit)
c = UBound(Split(vSplit(0), vbTab, , vbTextCompare))
ReDim vR(0 To r, 0 To c)
For i = 0 To r
vRow = Split(vSplit(i), vbTab, , vbTextCompare)
If UBound(vRow) = c Then 'if it is empty line, skip it
For j = 0 To c
If IsNumeric(vRow(j)) Then
s = Format(vRow(j), "#,##0.000")
s = Replace(s, ".", "+")
s = Replace(s, ",", ".")
s = Replace(s, "+", ",")
vR(i, j) = s
Else
vR(i, j) = vRow(j)
End If
Next j
End If
Next i
TransToTextWithCsvUTF_8 = vR
Set objStream = Nothing
End Function
The Text to Columns should work for this:
Sub all()
Dim sourcepath As String
Dim sDir As String
Dim newpath As String
sourcepath = "C:\Users\snapier\Downloads\Test\"
newpath = sourcepath & "xlsx\"
'make sure subfolder xlsx was created before
sDir = Dir$(sourcepath & "*.csv", vbNormal)
Do Until Len(sDir) = 0
Workbooks.Open (sourcepath & sDir)
With ActiveWorkbook.Worksheets(1)
.UsedRange.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False
End With
With ActiveWorkbook
.SaveAs Filename:=Replace(Left(.FullName, InStrRev(.FullName, ".")), sourcepath, newpath) & "xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
.Close
End With
sDir = Dir$
Loop
End Sub
This is my current VBA code:
Option Explicit
Private Function LoopThroughFolder(RootFolder As String, CsvFolder As String, Status As String)
Dim folder, StrFile As String
Dim wks As Worksheet
folder = RootFolder & "\" & CsvFolder & "\" & Status
StrFile = Dir(folder & "\*.csv")
Do While Len(StrFile) > 0
Set wks = Worksheets(CsvFolder & Status)
ImportCsv folder & "\" & StrFile, wks
StrFile = Dir
Loop
'Debug.Print RootFolder & "\" & CsvFolder & "\" & Status & " >>> OK!"
End Function
Private Function ImportCsv(CsvFile As String, wks As Worksheet)
Dim row&, col As Integer
'Debug.Print CsvFile
row = wks.Cells(Rows.Count, 1).End(xlUp).row
With wks.QueryTables _
.Add(Connection:="TEXT;" & CsvFile, Destination:=wks.Cells(row + 1, 1))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Function
Public Sub ImportFolderCsv()
Dim RootFolder As String
RootFolder = "C:\Users\chinkai\Desktop\dims investigate"
Dim CsvFolders(1 To 2) As String
CsvFolders(1) = "csvVeh"
CsvFolders(2) = "csvCust"
Dim Statuses(1 To 2) As String
Statuses(1) = "FAIL"
Statuses(2) = "PASS"
Dim i, j As Integer
Dim folder As String
Dim ws As Worksheet
For i = 1 To 1
For j = 1 To 2
Sheets.Add.Name = CsvFolders(i) & Statuses(j)
LoopThroughFolder RootFolder, CsvFolders(i), Statuses(j)
Next j
Next i
End Sub
When I open my worksheets to view, the data appears in the form of an inverted triangle. Data from the first CSV goes into the top right corner, data from the second CSV goes below but to the left, so on and so forth, until the last CSV where data appears in the bottom left corner.
What my data looks like:
New to Excel VBA, so most of the code here are copy-pasta. I tried to tweak what I can but now I am not sure where I have gone wrong. Advice/feedback appreciated, thank you!
Edit: made some changes as suggested. Updated my code above and also provided a screen capture of this weird display...
I have played a bit with your code, but I could not replicate the "reversed triangle thing". However, just to make you started somewhere:
Replace the ActiveSheet with a reference of the worksheet, that you should pass as a parameter to the ImportCsv function:
Private Function ImportCsv(CsvFile As String, wks As Worksheet)
Dim row&, col As Long
Debug.Print CsvFile
row = wks.Cells(Rows.Count, 1).End(xlUp).row
With wks.QueryTables _
.Add(Connection:="TEXT;" & CsvFile, Destination:=wks.Cells(row + 1, 1))
And you take the wks like this from the Status string:
Private Function LoopThroughFolder(RootFolder As String, CsvFolder As String, Status As String)
Dim folder, StrFile As String
Dim wks As Worksheet
folder = RootFolder & "\" & CsvFolder & "\" & Status
StrFile = Dir(folder & "\*.csv")
Do While Len(StrFile) > 0
Set wks = Worksheets("csvVeh" & Status)
Two more important points:
write Option Explicit on the top of your module and try to declare all variables. Then go to Debug>Compile on the VBEditor ribbon and declare what is not declared.
as #Peh mentioned in the comments if you declare like this in C++ Dim a, b as Integer, then a and b are Integers. In VBA only b is declared as an Integer, a is a Variant. You should declare Dim a As Integer, b as Integer
Why Use Integer Instead of Long?
I have a workbook that contains a macro that i wish to use to update the location of a connection in another workbook. The VBA script creates a folder, populates it with a log file containing data called log.txt and a copy of an excel file that is pre formatted to fill with the data allowing the user to see graphs and a detailed breakdown of the data. it is a door opening log, tracking numbers of times the door has been used.
here is the VBA code I've come up with so far.
note: I did a couple of years programming in C++ but haven't touched it in a decade. I have tried searching around for the code and even recording a macro of the actions I take when refreshing the connection manually. however if I try and use that code it gives a "Run time error 1004" Application defined or object defined error.
Here is the code. The commented out bit at the bottom is the result of the macro recorded from manually altering the connection.
Any help would be greatly received.
Sub Lof_File_Macro()
' Log_file_Macro Macro
' Runs script for monthly counts '
Dim strfolder1, strmonthno, strmonth, stryear, strfoldername, strfile, strmonyr, stlogfile, strfutfile
'date strings defined using date functions - ofset for 28 days to allow running anytime within 20 days into the next month whilereturning correct month
strmonthno = Month(Date - 28)
strmonth = MonthName((strmonthno), True)
stryear = Year(Date - 28)
strmonyr = " " & strmonth & " " & stryear
strfolder = "C:\Users\jtaylor7\Desktop\futures\People Counter" & strmonyr
strfile = "Futures People" & strmonyr & ".xls"
strlogfile = strfolder & "\" & "log" & strmonyr & ".txt"
strfutfile = strfolder & "\" & strfile
MkDir (strfolder)
FileCopy "C:\Users\jtaylor7\Desktop\futures\log.log", strlogfile
FileCopy "C:\Users\jtaylor7\Desktop\futures\template.xls", strfutfile
'Workbooks.Open Filename:=strfutfile
'ActiveWorkbook.Connections.AddFromFile (strlogfile)
'
'
' Perform data connection modification on file
'' Windows(strfutfile).Activate
' With ActiveWorkbook.Connections("log")
' .Name = "log"
' .Description = ""
' End With
' Range("$A$1:$H$1").Select
'With Selection.QueryTable
' .Connection = "TEXT;strlogfile"
' .TextFilePlatform = 850
' .TextFileStartRow = 1
' .TextFileParseType = xlDelimited
' .TextFileTextQualifier = xlTextQualifierDoubleQuote
' .TextFileConsecutiveDelimiter = False
' .TextFileTabDelimiter = False
' .TextFileSemicolonDelimiter = False
' .TextFileCommaDelimiter = True
' .TextFileSpaceDelimiter = False
' .TextFileOtherDelimiter = "/"
' .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
' .TextFileTrailingMinusNumbers = True
' .Refresh BackgroundQuery:=False
' End With
' Range("I4").Select
' ActiveWorkbook.Connections("log").Refresh
'' Windows("Run Me.xls").Activate
'
End Sub
I know its a bit messy, and if anyone needs any further data please ask.
Something like this should do the trick.
Pls update your paths from my testing below
Sub LogFile_Macro()
Dim strFolder As String
Dim strMonthno As String
Dim strMonth As String
Dim strYear As String
Dim strFoldername As String
Dim strFile As String
Dim strMonyr As String
Dim strLogfile As String
Dim strFutfile As String
Dim wb As Workbook
'date strings defined using date functions - ofset for 28 days to allow running anytime within 20 days into the next month whilereturning correct month
strMonthno = Month(Date - 28)
strMonth = MonthName((strMonthno), True)
strYear = Year(Date - 28)
strMonyr = " " & strMonth & " " & strYear
strFolder = "C:\temp\People Counter" & strMonyr
strFile = "Futures People" & strMonyr & ".xls"
strLogfile = strFolder & "\" & "log" & strMonyr & ".txt"
strFutfile = strFolder & "\" & strFile
On Error Resume Next
MkDir strFolder
If Err.Number <> 0 Then
MsgBox "cannot create path", vbCritical
Exit Sub
End If
On Error GoTo 0
FileCopy "C:\temp\futures\log.log", strLogfile
FileCopy "C:\temp\futures\template.xls", strFutfile
Set wb = Workbooks.Open(strFutfile)
With wb.Sheets(1).QueryTables.Add(Connection:="TEXT;" & strLogfile, Destination:=Range("A1:H1"))
.Name = "log"
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileCommaDelimiter = True
.TextFileOtherDelimiter = "/"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
.Refresh
End With
Windows("Run Me.xls").Activate
End Sub