MSAccess VBA Shell: UNZIP - ms-access

I am using a simple ZIP/UNZIP utility (http://infozip.sourceforge.net/) called from a WScript.Shell.
strPath = CurrentProject.Path & "\Backend_Databases\"
strPathUtil = CurrentProject.Path & "\Backend_Databases\DB_Utilities\"
ChDir strPath
strCMD = strPathUtil & "UNZIP.exe -o Item_4892.zip"
fShellRun (strCMD)
I get NO result & no complaint with this approach. The resulting strCMD looks like this:
C:\Users\Mark\Desktop\Backend_Databases\DB_Utilities\UNZIP.exe -o Item_4892.zip
This line works from a Command Window exactly as expected. fShellRun works as expected for other Shell Commands in use in my AccessDB.
Note: I could swear this was working like last week during initial testing, but I just cannot seem to figure this out now; it is making me completely batty! Maybe I am just too close to this and I am missing something obvious.
Any ideas?

The following works. My original fShellRun was customized for other purposes long ago and not compatible with this task.
The following is very simple and functional, runs silently:
Private Sub UnzipTest_Click()
Dim oShell
Dim strFile As String
Dim strPath As String
Dim strPathUtil As String
Set oShell = CreateObject("WScript.shell")
strFile = Me!txtFilename
strPath = CurrentProject.Path & "\Backend_Databases\"
strPathUtil = CurrentProject.Path & "\Backend_Databases\DB_Utilities\"
strCMD = strPathUtil & "UNZIP.exe -o " & strPath & strFile & " -d " & strPath
oShell.Run strCMD, 0, True
Set oShell = Nothing
End Sub
Note: This points to a 3rd party UNZIP utility, vs the std Windows ZIP utility. The UNZIP.exe is kept in my "...\DB_Utilities" folder.
http://infozip.sourceforge.net/

Related

Display Pdf preview in Ms Access Report using pdf file path

I am new in MS Access. I have pdf file location in textbox. I want when access report load then specific pdf file preview in that report (pdf read from file location). How can I achieve it? Please help?
You can display PDF in Report by converting its pages to images and display them. Withwsh.Runyou can extract duringReport_Loadevent, then store the pages paths in a temporary table.
Have Irfanview with PDF-Plugin installed.
In Front-End, create a table namedTmpExtractedPageswith oneShort-Textfield namedPathto store the paths of the extracted pages.
Create a report with Record-Source.
SELECT TmpExtractedPages.Path FROM TmpExtractedPages;
Add a Picture-Control in Detail-Section (no Header/Footer-Section), that fits to the page and bind it toPath
Put the following code inReport_Loadevent
Private Sub Report_Load()
Dim TempPath As String
TempPath = CurrentProject.Path & "\TempPdf"
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(TempPath) Then
fso.DeleteFolder TempPath
End If
fso.CreateFolder TempPath
Dim PdfFile As String
PdfFile = Me.OpenArgs
Const PathToIrfanView As String = "C:\Program Files (x86)\IrfanView\i_view32.exe"
Dim CmdArgs As String
CmdArgs = Chr(34) & PdfFile & Chr(34) & " /extract=(" & Chr(34) & TempPath & Chr(34) & ",jpg) /cmdexit" 'see i_options.txt in IrfanView folder for command line options
Dim ShellCmd As String
ShellCmd = Chr(34) & PathToIrfanView & Chr(34) & " " & CmdArgs
Debug.Print ShellCmd
Dim wsh As Object
Set wsh = CreateObject("WScript.Shell")
Const WaitOnReturn As Boolean = True
Const WindowStyle As Long = 0
wsh.Run ShellCmd, WindowStyle, WaitOnReturn
With CurrentDb
.Execute "Delete * From TmpExtractedPages", dbFailOnError
Dim f As Object
For Each f In fso.GetFolder(TempPath).Files
.Execute "Insert Into TmpExtractedPages (Path) Values ('" & Replace(f.Path, "'", "''") & "');", dbFailOnError
Next f
End With
Set fso = Nothing
Set wsh = Nothing
End Sub
You provide the path to the PDF to display asOpenArgsargument on open report:
DoCmd.OpenReport "rpt_pdf", acViewPreview, , , , "path\to\pdf"
Keep in mind that adding, then deleting records to the temp table, will bloat your database if you don't compact it later (or just deploy a fresh Front-End copy on start, as I do).
If you just need to display the pdf file, you could create a button next to the textbox and in its on click event:
Private Sub cmdView_Click()
If Nz(Me.txtPdfLocation) <> "" Then
Application.FollowHyperlink Me.txtPdfLocation
End If
End Sub

Importing Multiple CSV Files into Microsoft Access 2016

I have multiple very similar CSV files saved in the same directory which I want to import into Access in one go. I want them to all go to one table.
I did some research, taught myself some VBA basics and ended up with this script:
Public Function Import()
Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
blnHasFieldNames = True
strPath = "C:\Downloads\models"
strTable = "ModelData"
strFile = Dir(strPath & "*.csv")
Do While Len(strFile) > 0
strPathFile = strPath & strFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strTable, strPathFile, blnHasFieldNames
strFile = Dir()
Loop
End Function
Trying to run the macro doesn't do anything and I'm stuck where to move forward from here.
I followed the same guide to running a macro in this quick minute long video: https://www.youtube.com/watch?v=mXdn7ca2BX4
I'm hoping I just missed a little step somewhere...
Also, I think I need to import each column in text format as one is not returning date/time data correctly.
I have tried to follow some similar questions on here however I do not really understand VBA coding :/
Any help would be great! thanks!
For CSV file files you have to use DoCmd.TransferText:
DoCmd.TransferText TransferType:=acImportDelim, _
TableName:=strTable, _
FileName:=strPathFile, _
HasFieldNames:=True

Automatically merge split ms access database

At work we have a split ms access database. The backend lies on a drive that is mapped locally (so for everyone it's the same path). I know want to create a button in the frontend that when clicked automatically creates a merged version of the database. This version is necessary for out specific backup/history needs. I have very little knowledge of VBA programming, so any help is appreciated.
To create the merged version the code should just execute the following:
Create duplicate frontend (?)
Delete all existing tables in the duplicate
Import tables from the backend into the duplicate
(I am aware that it is not such a good idea to merge split databases, but in this case with many users that have absolutely no knowledge of CS it is the most usable solution)
Create a Module in the front-end database with the following Function
Public Function ImportLinkedTables()
Dim cdb As DAO.Database, tbd As DAO.TableDef
Dim tablesToLink As Collection, item As Variant, a() As String
Const LinkPrefix = ";DATABASE="
Set cdb = CurrentDb
Set tablesToLink = New Collection
For Each tbd In cdb.TableDefs
If tbd.Connect Like (LinkPrefix & "*") Then
'' tab-delimited list: TableDef name [tab] Source file [tab] Source table
tablesToLink.Add tbd.Name & vbTab & Mid(tbd.Connect, Len(LinkPrefix) + 1) & vbTab & tbd.SourceTableName
End If
Next
Set tbd = Nothing
For Each item In tablesToLink
a = Split(item, vbTab, -1, vbBinaryCompare)
DoCmd.DeleteObject acTable, a(0)
Debug.Print "Importing [" & a(0) & "]"
DoCmd.TransferDatabase acImport, "Microsoft Access", a(1), acTable, a(2), a(0), False
Next
Set tablesToLink = Nothing
Set cdb = Nothing
DoCmd.Quit
End Function
Create a Macro named "ImportLinkedTables" with a single step:
RunCode
Function Name ImportLinkedTables()
The code behind the form button to kick off the process would be
Private Sub Command0_Click()
Dim fso As FileSystemObject
Dim wshShell As wshShell
Dim accdbName As String, command As String
Const SourceFolder = "Y:\_dev\"
Const DestFolder = "C:\Users\Gord\Desktop\"
accdbName = Application.CurrentProject.Name
'' copy front-end file to new location
Set fso = New FileSystemObject
fso.CopyFile SourceFolder & accdbName, DestFolder & accdbName, True
Set fso = Nothing
Set wshShell = New wshShell
command = """"
command = command & wshShell.RegRead("HKLM\Software\Microsoft\Office\" & Application.Version & "\Common\InstallRoot\Path")
command = command & "MSACCESS.EXE"" """ & DestFolder & accdbName & """ /x ImportLinkedTables"
wshShell.Run command, 7, False
Set wshShell = Nothing
End Sub

How to open a folder in Windows Explorer from VBA?

I want to click a button on my access form that opens a folder in Windows Explorer.
Is there any way to do this in VBA?
You can use the following code to open a file location from vba.
Dim Foldername As String
Foldername = "\\server\Instructions\"
Shell "C:\WINDOWS\explorer.exe """ & Foldername & "", vbNormalFocus
You can use this code for both windows shares and local drives.
VbNormalFocus can be swapper for VbMaximizedFocus if you want a maximized view.
The easiest way is
Application.FollowHyperlink [path]
Which only takes one line!
Thanks to PhilHibbs comment (on VBwhatnow's answer) I was finally able to find a solution that both reuses existing windows and avoids flashing a CMD-window at the user:
Dim path As String
path = CurrentProject.path & "\"
Shell "cmd /C start """" /max """ & path & """", vbHide
where 'path' is the folder you want to open.
(In this example I open the folder where the current workbook is saved.)
Pros:
Avoids opening new explorer instances (only sets focus if window exists).
The cmd-window is never visible thanks to vbHide.
Relatively simple (does not need to reference win32 libraries).
Cons:
Window maximization (or minimization) is mandatory.
Explanation:
At first I tried using only vbHide. This works nicely... unless there is already such a folder opened, in which case the existing folder window becomes hidden and disappears! You now have a ghost window floating around in memory and any subsequent attempt to open the folder after that will reuse the hidden window - seemingly having no effect.
In other words when the 'start'-command finds an existing window the specified vbAppWinStyle gets applied to both the CMD-window and the reused explorer window. (So luckily we can use this to un-hide our ghost-window by calling the same command again with a different vbAppWinStyle argument.)
However by specifying the /max or /min flag when calling 'start' it prevents the vbAppWinStyle set on the CMD window from being applied recursively. (Or overrides it? I don't know what the technical details are and I'm curious to know exactly what the chain of events is here.)
Here is some more cool knowledge to go with this:
I had a situation where I needed to be able to find folders based on a bit of criteria in the record and then open the folder(s) that were found. While doing work on finding a solution I created a small database that asks for a search starting folder gives a place for 4 pieces of criteria and then allows the user to do criteria matching that opens the 4 (or more) possible folders that match the entered criteria.
Here is the whole code on the form:
Option Compare Database
Option Explicit
Private Sub cmdChooseFolder_Click()
Dim inputFileDialog As FileDialog
Dim folderChosenPath As Variant
If MsgBox("Clear List?", vbYesNo, "Clear List") = vbYes Then DoCmd.RunSQL "DELETE * FROM tblFileList"
Me.sfrmFolderList.Requery
Set inputFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
With inputFileDialog
.Title = "Select Folder to Start with"
.AllowMultiSelect = False
If .Show = False Then Exit Sub
folderChosenPath = .SelectedItems(1)
End With
Me.txtStartPath = folderChosenPath
Call subListFolders(Me.txtStartPath, 1)
End Sub
Private Sub cmdFindFolderPiece_Click()
Dim strCriteria As String
Dim varCriteria As Variant
Dim varIndex As Variant
Dim intIndex As Integer
varCriteria = Array(Nz(Me.txtSerial, "Null"), Nz(Me.txtCustomerOrder, "Null"), Nz(Me.txtAXProject, "Null"), Nz(Me.txtWorkOrder, "Null"))
intIndex = 0
For Each varIndex In varCriteria
strCriteria = varCriteria(intIndex)
If strCriteria <> "Null" Then
Call fnFindFoldersWithCriteria(TrailingSlash(Me.txtStartPath), strCriteria, 1)
End If
intIndex = intIndex + 1
Next varIndex
Set varIndex = Nothing
Set varCriteria = Nothing
strCriteria = ""
End Sub
Private Function fnFindFoldersWithCriteria(ByVal strStartPath As String, ByVal strCriteria As String, intCounter As Integer)
Dim fso As New FileSystemObject
Dim fldrStartFolder As Folder
Dim subfldrInStart As Folder
Dim subfldrInSubFolder As Folder
Dim subfldrInSubSubFolder As String
Dim strActionLog As String
Set fldrStartFolder = fso.GetFolder(strStartPath)
' Debug.Print "Criteria: " & Replace(strCriteria, " ", "", 1, , vbTextCompare) & " and Folder Name is " & Replace(fldrStartFolder.Name, " ", "", 1, , vbTextCompare) & " and Path is: " & fldrStartFolder.Path
If fnCompareCriteriaWithFolderName(fldrStartFolder.Name, strCriteria) Then
' Debug.Print "Found and Opening: " & fldrStartFolder.Name & "Because of: " & strCriteria
Shell "EXPLORER.EXE" & " " & Chr(34) & fldrStartFolder.Path & Chr(34), vbNormalFocus
Else
For Each subfldrInStart In fldrStartFolder.SubFolders
intCounter = intCounter + 1
Debug.Print "Criteria: " & Replace(strCriteria, " ", "", 1, , vbTextCompare) & " and Folder Name is " & Replace(subfldrInStart.Name, " ", "", 1, , vbTextCompare) & " and Path is: " & fldrStartFolder.Path
If fnCompareCriteriaWithFolderName(subfldrInStart.Name, strCriteria) Then
' Debug.Print "Found and Opening: " & subfldrInStart.Name & "Because of: " & strCriteria
Shell "EXPLORER.EXE" & " " & Chr(34) & subfldrInStart.Path & Chr(34), vbNormalFocus
Else
Call fnFindFoldersWithCriteria(subfldrInStart, strCriteria, intCounter)
End If
Me.txtProcessed = intCounter
Me.txtProcessed.Requery
Next
End If
Set fldrStartFolder = Nothing
Set subfldrInStart = Nothing
Set subfldrInSubFolder = Nothing
Set fso = Nothing
End Function
Private Function fnCompareCriteriaWithFolderName(strFolderName As String, strCriteria As String) As Boolean
fnCompareCriteriaWithFolderName = False
fnCompareCriteriaWithFolderName = InStr(1, Replace(strFolderName, " ", "", 1, , vbTextCompare), Replace(strCriteria, " ", "", 1, , vbTextCompare), vbTextCompare) > 0
End Function
Private Sub subListFolders(ByVal strFolders As String, intCounter As Integer)
Dim dbs As Database
Dim fso As New FileSystemObject
Dim fldFolders As Folder
Dim fldr As Folder
Dim subfldr As Folder
Dim sfldFolders As String
Dim strSQL As String
Set fldFolders = fso.GetFolder(TrailingSlash(strFolders))
Set dbs = CurrentDb
strSQL = "INSERT INTO tblFileList (FilePath, FileName, FolderSize) VALUES (" & Chr(34) & fldFolders.Path & Chr(34) & ", " & Chr(34) & fldFolders.Name & Chr(34) & ", '" & fldFolders.Size & "')"
dbs.Execute strSQL
For Each fldr In fldFolders.SubFolders
intCounter = intCounter + 1
strSQL = "INSERT INTO tblFileList (FilePath, FileName, FolderSize) VALUES (" & Chr(34) & fldr.Path & Chr(34) & ", " & Chr(34) & fldr.Name & Chr(34) & ", '" & fldr.Size & "')"
dbs.Execute strSQL
For Each subfldr In fldr.SubFolders
intCounter = intCounter + 1
sfldFolders = subfldr.Path
Call subListFolders(sfldFolders, intCounter)
Me.sfrmFolderList.Requery
Next
Me.txtListed = intCounter
Me.txtListed.Requery
Next
Set fldFolders = Nothing
Set fldr = Nothing
Set subfldr = Nothing
Set dbs = Nothing
End Sub
Private Function TrailingSlash(varIn As Variant) As String
If Len(varIn) > 0& Then
If Right(varIn, 1&) = "\" Then
TrailingSlash = varIn
Else
TrailingSlash = varIn & "\"
End If
End If
End Function
The form has a subform based on the table, the form has 4 text boxes for the criteria, 2 buttons leading to the click procedures and 1 other text box to store the string for the start folder. There are 2 text boxes that are used to show the number of folders listed and the number processed when searching them for the criteria.
If I had the Rep I would post a picture... :/
I have some other things I wanted to add to this code but haven't had the chance yet. I want to have a way to store the ones that worked in another table or get the user to mark them as good to store.
I can not claim full credit for all the code, I cobbled some of it together from stuff I found all around, even in other posts on stackoverflow.
I really like the idea of posting questions here and then answering them yourself because as the linked article says, it makes it easy to find the answer for later reference.
When I finish the other parts I want to add I will post the code for that too. :)
You can use command prompt to open explorer with path.
here example with batch or command prompt:
start "" explorer.exe (path)
so In VBA ms.access you can write with:
Dim Path
Path="C:\Example"
shell "cmd /c start """" explorer.exe " & Path ,vbHide
Here is what I did.
Dim strPath As String
strPath = "\\server\Instructions\"
Shell "cmd.exe /c start """" """ & strPath & """", vbNormalFocus
Pros:
Avoids opening new explorer instances (only sets focus if window
exists).
Relatively simple (does not need to reference win32 libraries).
Window maximization (or minimization) is not mandatory. Window will open with normal size.
Cons:
The cmd-window is visible for a short time.
This consistently opens a window to the folder if there is none open and switches to the open window if there is one open to that folder.
Thanks to PhilHibbs and AnorZaken for the basis for this. PhilHibbs comment didn't quite work for me, I needed to the command string to have a pair of double quotes before the folder name. And I preferred having a command prompt window appear for a bit rather than be forced to have the Explorer window maximized or minimized.
I may not use shell command because of security in the company so the best way I found on internet.
Sub OpenFileOrFolderOrWebsite()
'Shows how to open files and / or folders and / or websites / or create emails using the FollowHyperlink method
Dim strXLSFile As String, strPDFFile As String, strFolder As String, strWebsite As String
Dim strEmail As String, strSubject As String, strEmailHyperlink As String
strFolder = "C:\Test Files\"
strXLSFile = strFolder & "Test1.xls"
strPDFFile = strFolder & "Test.pdf"
strWebsite = "http://www.blalba.com/"
strEmail = "mailto:YourEmailHere#Website.com"
strSubject = "?subject=Test"
strEmailHyperlink = strEmail & strSubject
'**************FEEL FREE TO COMMENT ANY OF THESE TO TEST JUST ONE ITEM*********
'Open Folder
ActiveWorkbook.FollowHyperlink Address:=strFolder, NewWindow:=True
'Open excel workbook
ActiveWorkbook.FollowHyperlink Address:=strXLSFile, NewWindow:=True
'Open PDF file
ActiveWorkbook.FollowHyperlink Address:=strPDFFile, NewWindow:=True
'Open VBAX
ActiveWorkbook.FollowHyperlink Address:=strWebsite, NewWindow:=True
'Create New Email
ActiveWorkbook.FollowHyperlink Address:=strEmailHyperlink, NewWindow:=True
'******************************************************************************
End Sub
so actually its
strFolder = "C:\Test Files\"
and
ActiveWorkbook.FollowHyperlink Address:=strFolder, NewWindow:=True
Shell "C:\WINDOWS\explorer.exe /select,""" & ActiveWorkbook.Name & "", vbNormalFocus
Here's an answer that gives the switch-or-launch behaviour of Start, without the Command Prompt window. It does have the drawback that it can be fooled by an Explorer window that has a folder of the same name elsewhere opened. I might fix that by diving into the child windows and looking for the actual path, I need to figure out how to navigate that.
Usage (requires "Windows Script Host Object Model" in your project's References):
Dim mShell As wshShell
mDocPath = whatever_path & "\" & lastfoldername
mExplorerPath = mShell.ExpandEnvironmentStrings("%SystemRoot%") & "\Explorer.exe"
If Not SwitchToFolder(lastfoldername) Then
Shell PathName:=mExplorerPath & " """ & mDocPath & """", WindowStyle:=vbNormalFocus
End If
Module:
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function BringWindowToTop Lib "user32" _
(ByVal lngHWnd As Long) As Long
Function SwitchToFolder(pFolder As String) As Boolean
Dim hWnd As Long
Dim mRet As Long
Dim mText As String
Dim mWinClass As String
Dim mWinTitle As String
SwitchToFolder = False
hWnd = FindWindowEx(0, 0&, vbNullString, vbNullString)
While hWnd <> 0 And SwitchToFolder = False
mText = String(100, Chr(0))
mRet = GetClassName(hWnd, mText, 100)
mWinClass = Left(mText, mRet)
If mWinClass = "CabinetWClass" Then
mText = String(100, Chr(0))
mRet = GetWindowText(hWnd, mText, 100)
If mRet > 0 Then
mWinTitle = Left(mText, mRet)
If UCase(mWinTitle) = UCase(pFolder) Or _
UCase(Right(mWinTitle, Len(pFolder) + 1)) = "\" & UCase(pFolder) Then
BringWindowToTop hWnd
SwitchToFolder = True
End If
End If
End If
hWnd = FindWindowEx(0, hWnd, vbNullString, vbNullString)
Wend
End Function
Private Sub Command0_Click()
Application.FollowHyperlink "D:\1Zsnsn\SusuBarokah\20151008 Inventory.mdb"
End Sub
I just used this and it works fine:
System.Diagnostics.Process.Start("C:/Users/Admin/files");
Thanks to many of the answers above and elsewhere, this was my solution to a similar problem to the OP. The problem for me was creating a button in Word that asks the user for a network address, and pulls up the LAN resources in an Explorer window.
Untouched, the code would take you to \\10.1.1.1\Test, so edit as you see fit. I'm just a monkey on a keyboard, here, so all comments and suggestions are welcome.
Private Sub CommandButton1_Click()
Dim ipAddress As Variant
On Error GoTo ErrorHandler
ipAddress = InputBox("Please enter the IP address of the network resource:", "Explore a network resource", "\\10.1.1.1")
If ipAddress <> "" Then
ThisDocument.FollowHyperlink ipAddress & "\Test"
End If
ExitPoint:
Exit Sub
ErrorHandler:
If Err.Number = "4120" Then
GoTo ExitPoint
ElseIf Err.Number = "4198" Then
MsgBox "Destination unavailable"
GoTo ExitPoint
End If
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Resume ExitPoint
End Sub

Is it possible to batch convert csv to xls using a macro?

I have a large amount of csv files that I need in .xls format. Is it possible to run a batch conversion with a macro or best done with another language?
I have used this code http://www.ozgrid.com/forum/showthread.php?t=71409&p=369573#post369573 to reference my directory but I'm not sure of the command to open each file and save them. Here's what I have:
Sub batchconvertcsvxls()
Dim wb As Workbook
Dim CSVCount As Integer
Dim myVar As String
myVar = FileList("C:\Documents and Settings\alistairw\My Documents\csvxlstest")
For i = LBound(myVar) To UBound(myVar)
With wb
Application.Workbooks.OpenText 'How do I reference the myvar string ?
wb.SaveAs '....
End With
Next
End Sub
Function FileList(fldr As String, Optional fltr As String = "*.*") As Variant
Dim sTemp As String, sHldr As String
If Right$(fldr, 1) <> "\" Then fldr = fldr & "\"
sTemp = Dir(fldr & fltr)
If sTemp = "" Then
FileList = Split("No files found", "|") 'ensures an array is returned
Exit Function
End If
Do
sHldr = Dir
If sHldr = "" Then Exit Do
sTemp = sTemp & "|" & sHldr
Loop
FileList = Split(sTemp, "|")
End Function
Edit: The files are .txt files formatted as csv
By combining the code given by Scott Holtzman and 'ExcelFreak', the conversion works quite well. The final code looks something like this:
Sub CSV_to_XLS()
Dim wb As Workbook
Dim strFile As String, strDir As String
strDir = "U:\path\"
strFile = Dir(strDir & "*.csv")
Do While strFile <> ""
Set wb = Workbooks.Open(Filename:=strDir & strFile, Local:=True)
wb.SaveAs Replace(wb.FullName, ".csv", ".xls"), 50 'UPDATE:
wb.Close True
Set wb = Nothing
strFile = Dir
Loop
End Sub
Opening the converted .xls file throws a warning everytime:
"The file you are trying to open, 'filename', is in a different format than specified by the file extension. Verify that the file is not corrupted and is from a trusted source before opening the file. Do you want to open the file now?"
Clicking Yes then opens the .xls file.
Is there a way to get rid of this warning message? Excel throws a warning everytime the .xls file is opened.
In a lot less lines of code, this should get you what you want. However, I will say this may not be the fastest way to get it done, because you are opening, saving, and closing the workbook every time. I will look for a faster way, but I forget the method off the top of my head.
Sub batchconvertcsvxls()
Dim wb As Workbook
Dim strFile As String, strDir As String
strDir = "C:\"
strFile = Dir(strDir & "*.csv")
Do While strFile <> ""
Set wb = Workbooks.Open(strDir & strFile)
With wb
.SaveAs Replace(wb.FullName, ".csv", ".xls"), 50 'UPDATE:
.Close True
End With
Set wb = Nothing
Loop
End Sub
** UPDATE **
you need the proper fileformat enumeration for a .xls file. I think its 50, but you can check here Excel File Type Enumeration, if it's not.
The Code of Scott Holtzman nearly did it for me. I had to make two changes to get it to work:
He forgot to add the line that makes our loop continue with the next file. The last line before the Loop should read
strFile = Dir
The Workbooks.Open method did not read my CSV files as expected (the whole line ended up to be text in the first cell). When I added the parameter Local:=True it worked:
Set wb = Workbooks.Open(Filename:=strDir & strFile, Local:=True)
This works properly at least on Excel 2013. Using FileFormat:=xlExcel8 parameter instead of the filetype tag 50 creates files that open without security nags.
Sub CSV_to_XLS()
Dim wb As Workbook
Dim strFile As String, strDir As String
strDir = "C:\temp\"
strFile = Dir(strDir & "*.csv")
Do While strFile <> ""
Set wb = Workbooks.Open(Filename:=strDir & strFile, Local:=True)
wb.SaveAs Replace(wb.FullName, ".csv", ".xls"), FileFormat:=xlExcel8
wb.Close True
Set wb = Nothing
strFile = Dir
Loop
End Sub
This was a good question and I have found in the internet several answers. Just making very small changes (I couldn't edit any of the codes already published) I could make things work a bit better:
Sub CSV_to_XLSX()
Dim wb As Workbook
Dim strFile As String, strDir As String
strDir = "C:\Users\acer\OneDrive\Doctorado\Study 1\data\Retest Bkp\Day 1\Sart\"
strFile = Dir(strDir & "*.csv")
Do While strFile <> ""
Set wb = Workbooks.Open(Filename:=strDir & strFile, Local:=True)
With wb
.SaveAs Replace(wb.FullName, ".csv", ".xlsx"), 51
.Close True
End With
Set wb = Nothing
strFile = Dir
Loop
End Sub