I'm developing a script in VBA (inside a workspace, not MS office program) that needs to use a small excel file as input. I want to use the data in the excel file and load it into a 2D array so that I can make decisions within my script based on this data.
I've tried to google this problem but generally I find problems within excel, but I haven't had any luck finding anything for vba scripting outside MS office.
Can I just use a .Xlsx as inputfile?
How do I put this data into a 2d array? My file only has 11 rows & 2 columns.
Thank you for your time.
This is confusing. VBA = MS Office VBA, as far as I know. Do you mean VB.NET? VBS? Anyway, to extract data from an xlsx file without opening it in Excel, you either need to unzip it and dig through the XML files inside, or use Office Open XML SDK or any other package like that.
Open XML SDK
Office Open XML fileformat
I think this will also work for Visual Basic [for Applications]; I tried it in Excel VBA and Word VBA:
In VBA Development Environment, select Tools, References. In the list that now appears, check the Object Model you need. In your case you will want to check the Microsoft Excel 12.0 Object Library.
You now have access to the complete Excel Object Model in your application and can open and manipulate an Excel spreadsheet file as you need.
The following code in VB for Word opens an Excel Spreadsheet and gets the value of the first cell:
Sub ExcelTestInWord()
Dim oExcel As Object
Dim wb As Object
Dim v
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
Dim vrtSelectedItem As Variant
Set oExcel = CreateObject("Excel.Application")
'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)
If (fd.Show = -1) Then
For Each vrtSelectedItem In fd.SelectedItems
Set wb = oExcel.Workbooks.Open(vrtSelectedItem)
v = wb.Sheets(1).Cells(1).Value
wb.Close
Next vrtSelectedItem
End If
End Sub
Consider the VBScript code below as an example, save it as .vbs file to launch:
Option Explicit
Dim strSourceFilePath, strSourceSheetName, strSourceRange, arrData, strResult, i, j
' set initial data
strSourceFilePath = "C:\Test\data.xlsx"
strSourceSheetName = "input"
strSourceRange = "A1:B11"
' get 2-dimensional array from Excel sheet
With CreateObject("Excel.Application")
.Visible = False
.DisplayAlerts = False
With .Workbooks.Open(strSourceFilePath)
arrData = .Sheets(strSourceSheetName).Range(strSourceRange).Value
.Close
End With
.Quit
End With
' array output for debug purposes
strResult = ""
For j = 1 To UBound(arrData, 1)
For i = 1 To UBound(arrData, 2)
strResult = strResult & arrData(j, i) & ";" & vbTab
Next
strResult = strResult & vbCrLf
Next
WScript.Echo strResult
Related
I'm getting this error, "Microsoft Excel is waiting for another application to complete an OLE action" when trying to automate a PDF string search and record findings in excel. For certain PDFs this error is not popping. I assume this is due to the less optimized PDFs taking a longer time to search string while indexing page by page.
To be more precise, I have a workbook containing two sheets. One contains a list of PDF file names and the other has a list of words that I want to search. From the file list the macro would open each PDF file and take each word from the list of words and perform a string search. If found it would record each finding in a new sheet in the same workbook with the file name and the found string.
Below is the code I'm struggling with. Any help is welcome.
Public Sub SearchWords()
'variables
Dim ps As Range
Dim fs As Range
Dim PList As Range
Dim FList As Range
Dim PLRow As Long
Dim FLRow As Long
Dim Tracker As Worksheet
Dim gapp As Object
Dim gAvDoc As Object
Dim gPDFPath As String
Dim sText As String 'String to search for
FLRow = ActiveWorkbook.Sheets("List Files").Range("B1").End(xlDown).Row
PLRow = ActiveWorkbook.Sheets("Prohibited Words").Range("A1").End(xlDown).Row
Set PList = ActiveWorkbook.Sheets("Prohibited Words").Range("A2:A" & PLRow)
Set FList = ActiveWorkbook.Sheets("List Files").Range("B2:B" & FLRow)
Set Tracker = ActiveWorkbook.Sheets("Tracker")
'For each PDF file list in Excel Range
For Each fs In FList
'Initialize Acrobat by creating App object
Set gapp = CreateObject("AcroExch.App")
'Set AVDoc object
Set gAvDoc = CreateObject("AcroExch.AVDoc")
'Set PDF file path to open in PDF
gPDFPath = fs.Cells.Value
' open the PDF
If gAvDoc.Open(gPDFPath, "") = True Then
'Bring the PDF to front
gAvDoc.BringToFront
'For each word list in the range
For Each ps In PList
'Assign String to search
sText = ps.Cells.Value
'This is where the error is appearing
If gAvDoc.FindText(sText, False, True, False) = True Then
'Record findings
Tracker.Range("A1").End(xlDown).Offset(1, 0) = fs.Cells.Offset(0, -1).Value
Tracker.Range("B1").End(xlDown).Offset(1, 0) = ps.Cells.Value
End If
Next
End If
'Message to display once the search is over for a particular PDF
MsgBox (fs.Cells.Offset(0, -1).Value & " assignment complete")
Next
gAvDoc.Close True
gapp.Exit
set gAVDoc = Nothing
set gapp = Nothing
End Sub
I have now found the answer to this problem.
I'm using Acrobat Pro and whenever I open a PDF file, it opens with limited features due to Protected View settings. If I disable this function or if I click Enable All Features and save changes to the PDF files, VBA macro runs smooth.
It's funny, I'm posting an answer to my own problem.
I am trying to copy the values of one column in a sheet to a text file. The code I currently have causes runtime error 434.
Sheets("Output to fcf.1").Columns("A").SaveToText "P:\4_Calcs\02. Flag Mapping\test_.txt"
If I try and save the whole sheet
Sheets("Output to fcf.2").SaveToText "P:\Clear Project Drive\CLE10276 AWS SMP Model Assessmnts\4_Calcs\02. Flag Mapping\test2_.txt"
I get the entire sheet converted into text rather than just the text in the sheet. Is there a simple way to do this?
Thanks in advance!
Not sure which Excel version you have but I don't see a method for SaveToText.
But this procedure should work, or at least get you started...
Sub SaveColumn(sheetName As String, columnName As String, fileName As String)
Dim cell
Dim fso
Dim file
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.CreateTextFile(fileName, True)
For Each cell In Sheets(sheetName).Columns(columnName).Cells
If cell.Value <> "" Then
file.WriteLine cell.Value
End If
Next
file.Close
Set file = Nothing
Set fso = Nothing
End Sub
To call it...
SaveColumn "Output to fcf.1", "A", "P:\4_Calcs\02. Flag Mapping\test_.txt"
This is designed to be used as a macro.
Step by step guide:
1) From excel, hit Alt+F11 on your keyboard.
2) From the menu bar, click Insert, then Module
3) Copy and paste the code provided below into the new module that opens.
NOTE: DocPath = "C:\docs\data.txt" should be wherever you want the output file saved, including the file's actual name. Remember, the folder you want the output file to be located in should ALREADY exist. This does not create the folder if it can't be found.
4) From the menu bar, click Tools, then References. Make sure both "Microsoft Office 14.0 Object Library" as well as "Microsoft Word 14.0 Object Library" are checked, and hit okay (See screenshot for details)
5) Save the document as an .xlsm file (This file type supports Macros)
6) Close the VBA editor. Back in Excel, on the ribbon click View and then Macros. Your new macro should be in the list as ExportToTXT
7) Select it and hit run.
Sub ExportToTXT()
Dim DocPath As String
Dim MsgBoxCompleted
Columns("A").Select
Dim AppWord As Word.Application
Set AppWord = CreateObject("Word.Application")
AppWord.Visible = False
Selection.Copy
DocPath = "C:\docs\data.txt"
'Create and save txt file
AppWord.Documents.Add
AppWord.Selection.Paste
AppWord.ActiveDocument.SaveAs2 Filename:=DocPath, FileFormat:=wdFormatText
Application.CutCopyMode = False
AppWord.Quit (wdDoNotSaveChanges)
Set AppWord = Nothing
MsgBoxCompleted = MsgBox("Process complete.", vbOKOnly, "Process complete")
End Sub
Good luck, and if you have any questions, don't hesitate to ask.
NOTE: These directions might seem overly simplified for your skill level, but I wrote the answer like this to potentially help others in the future.
EDIT
Change
DocPath = "C:\docs\data.txt"
to
DocPath = "C:\docs\data.fcf"
And change
AppWord.ActiveDocument.SaveAs2 Filename:=DocPath, FileFormat:=wdFormatText
to
AppWord.ActiveDocument.SaveAs2 Filename:=DocPath
The output file will be .fcf format. Whether or not it will open properly is something I'm not sure of. You'd have to test in the program you're using.
I've been trying to use transfer spreadsheet methods but they appear to require an output path.
I just need to find out how to take a given query and simply "open up" an Excel file that contains the query output. I don't need the file actually saved anywhere.
You can open up your file without saving it by creating an Excel instance (or grabbing an existing one) and using the CopyFromRecordset function of the Excel.Range object.
This assumes your data are in an ADO recordset. You need to have references to Microsoft Excel XX.0 Object Library and Microsoft ActiveX Data Objects X.X Library` (if you are using ADO. If you use DAO then use whatever DAO reference you need)
I use this to grab an an Excel app or create a new one is Excel is not open already. I use WasANewInstanceReturned to figure how I need to clean up the Excel resources at the end. (Obviously I don't want to quit Excel if it is being use by something else).
Function GetExcelApplication(Optional ByRef WasANewInstanceReturned As Boolean) As Excel.Application
If ExcelInstanceCount > 0 Then
Set GetExcelApplication = GetObject(, "Excel.Application")
WasANewInstanceReturned = False
Else
Set GetExcelApplication = New Excel.Application
WasANewInstanceReturned = True
End If
End Function
Then grab that instance
Dim ApXL As Excel.Application, WasANewInstanceReturned as Boolean
Set ApXL = GetExcelApplication(WasANewInstanceReturned)
Add a workbook
Dim wbExp As Excel.Workbook
Set wbExp = ApXL.Workbooks.Add
Grab the first sheet
Dim wsSheet1 As Excel.Worksheet
Set wsSheet1 = wbExp.Sheets(1)
Put your recordset's field names in the first row
Dim fld As ADODB.Field
Dim col As Integer
col = 1
With wsSheet1
For Each fld In rst.Fields
.Cells(1, col).Value = fld.Name 'puts the field names in the first row
End With
col = col + 1
Next fld
End With
Then move the data just below the field names
wsSheet1 .Range("A2").CopyFromRecordset rst
Voila! You have an excel file open, with your data that has not been saved anywhere!
I usually set ApXL.ScreenUpdating = False before doing any of this and ApXL.ScreenUpdating = True at the end.
I'll let you stitch this together for your needs.
The file must be saved somewhere for Excel to open it.
If the dataset is small enough, you can use copy/paste (no file here). Otherwise, just use the %TEMP% folder for the file location.
Edit:
One simple way to get the TEMP folder is to use =Environ("TEMP")
I open and export a query from access to excel. First I created a worksheet in excel and saved it. Then I created a module in the vba part of Access (2013):
Option Compare Database
' Testtoexporttoexcel'
Function ExportQuerytoExcel()
On Error GoTo ExportQuerytoExcel_Err
' Exports the query to excel to a sheet named Nameofyoursheet
DoCmd.TransferSpreadsheet acExport, 10, "nameofyourquery", "yourPath:\nameofyourworkbook", False, "Nameofyour worksheet"
ExportQuerytoExcel_Exit:
Exit Function
ExportQuerytoExcel_Err:
MsgBox Error$
Resume ExportQuerytoExcel_Exit
End Function
-----then add another function that says:
Option Compare Database
Function OpenExcelFromAccess()
'Opens Excel to the chart
Dim MYXL As Object
Set MYXL = CreateObject("Excel.Application")
With MYXL
.Application.Visible = True
.workbooks.Open "Yourpath:\nameofyourworkbook"
End With
'Application.Quit
End Function
hope this helps, this is my first time answering a question.
Aloha
I have been searching for some time on how exactly to go about this, but I keep coming up with a large number of possible ways that come close, but never really give me exactly the sort of thing I'm looking for. The concept is pretty simple I need to open a certian .xls file using some VBA code in Access 2010. Once the file is opened I need to insert data and do some things to the file then save the file as a different filename and close the file. I also need it to close excel if it was not already open and if it was open I need it to leave excel alone and not save/close anything other than the template.xls file I am working with. I currently have code that will do part of this provided Excel is not already open at the time the script runs. When excel is already opened I get the following error;
"Run-time'91': Object variable or With block variable not set."
When I click debug I get the following line highlighted
x.ActiveWorkbook.SaveAs fileName:=savedfilename
Here is the code without all the junk that doesn't relate to the issue. I have cobbled together using examples from various sites.
Dim DateSampled As String
Dim strPath As String
Dim TemplatePath As String
Dim x As Excel.Application
Dim xBook As Excel.Workbook
Dim xSheet As Excel.Worksheet
DateAsString = Format(DateSampled, "MMDDYYYY")
savedfilename = strPath & "\" & TrainNum & "-" & DateAsString & ".xls"
TemplatePath = "B:\template.xls"
Set x = CreateObject("Excel.Application")
x.Visible = False
Set xBook = GetObject(TemplatePath)
xBook.Windows(1).Visible = True
Set xSheet = xBook.Worksheets(1)
'---------------CODE DOES STUFF WITH THE FILE -----------------------
x.DisplayAlerts = False
x.ActiveWorkbook.SaveAs fileName:=savedfilename
x.DisplayAlerts = True
x.ActiveWorkbook.Close
Set x = Nothing
Set xBook = Nothing
Set xSheet = Nothing
There are a number of similar posts but nothing that does exactly what I want as simply as it needs to be for me to understand
I want to use Access 2007 VBA to open a csv file and replace the column headings row ie:
OldColumn1,OldColumn2
1,2
with
NewColumn1,NewColumn2
1,2
ie without disturbing the rump of data.
Then save and close.
I have tried this code, but it deletes my data:
Sub WriteFile()
Dim OutputFileNum As Integer
Dim PathName As String
PathName = Application.ActiveWorkbook.Path
OutputFileNum = FreeFile
Open PathName & "\Test.csv" For Output Lock Write As #OutputFileNum
Print #OutputFileNum, "NewCol1" & "," & "NewCol2"
Close OutputFileNum
End Sub
Import or link to the .csv so that you have the recordset in your Access 2007 databases.
Write a query with NewColumn[x] as an alias for OldColumn[x].
Write vba code to use TransferText functionality or make a macro to do the same to export your query as a .csv file (overwriting the original csv if you want/need).
Obviously, there are plenty of bonus things you could do to automate and reproduce this concept for any number or types of files. But the above solution should work in an all MS Access environment.
Let me know if you would like details on any of these steps.
Further to my earlier comment, please see the method which uses the Excel reference:
Public Sub EditCsv()
Dim xlApp As Object
dim xlWbk As Object
Dim xlWst As Object
Set xlApp = CreateObject("Excel.Application")
Set xlWbk = xlApp.Workbooks.Open ".../Test.csv" 'Amend this to your needs
Set xlWst = xlWbk.Sheets(1)
'This assumes the columns are at the beginning of the file
xlWst.Range("A1") = "My New Column Name"
xlWst.Range("B1") = "My New Second Column Name"
xlWbk.Close -1 'Close and save the file here
xlApp.Quit
Set xlApp = Nothing
Set xlWbk = Nothing
Set xlWst = Nothing
End Sub