Re: Copy associated cells for not blank cells.
Ive done as sugested, Just hope someone can help me do this as doing this manually would take so long.
Cheers..
Re: Copy associated cells for not blank cells.
Ive done as sugested, Just hope someone can help me do this as doing this manually would take so long.
Cheers..
I have a spreadsheet with date values in row 1 and in column A i have a list of jobs. We have thousands of entrys on this spreadsheet, which shows work we carried out and when.
In every cell with a value (not blank) I would like for that to be pasted on a new sheet, with the accociated date (row one) and associated job name (column A) to be pasted in the cells next to it.
It would take me weeks to go through all of this data manually, with each one checking dates and names. So if i have this in a table with the name/date/note all in a list format I can upload them to the database.
The dates are all now text values, so copying them isnt an issue.
Hope someone can help me put together some code.
forum.ozgrid.com/index.php?attachment/68775/
Edit: This is some sample data just showing what exists and what I want. I would like the new data to be on a new sheet, and in this example the data is far less than whats on the actual data.
thanks
Re: Method or data member not found
The one for the survey does work though and this is also in excel (the majority of the time). Can you sugest a solution or how I might change this? Thanks.
Re: Method or data member not found
Thanks for the replies, hope you had a good weekend.
Firstly I paid someone a few months ago to make this code, and it runs fine in excel. I cant get hold of the guy now. I do have some limited VBA knowlege but you can probably assume I have none.
I didnt want to fill up the thread with code that wasnt causing the error but it may help if you see everything.
This is from the excel document. (without the search functionality for site name)
Option Explicit
' This is giving us access to the Windows Shell which we'll use to print
' documents that aren't Word or Excel
Public Const SW_SHOWNORMAL As Long = 1
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Const FOLDER_TO_SEARCH = "[URL="file://\\SERVER\general\Installation\!SITES\BATCH"]\\SERVER\general\Installation\!SITES\BATCH[/URL] 4c\whaves_nw"
Const KEYWORD_SURVEY = "survey"
Const KEYWORD_RAMS = "rams"
Const KEYWORD_TESTPLAN = "test"
Const CONFIRMATION_PROMPT = False
Sub GetFilesToPrint()
Dim obj As Object
Dim MySource As Object
Dim file As Variant
Dim filesFound As Long
Dim cleanFolder As String
Dim boolPrintMe As Boolean
' If there's not a trailing backslash add one
If Right(FOLDER_TO_SEARCH, 1) <> "" Then
cleanFolder = FOLDER_TO_SEARCH & ""
Else
cleanFolder = FOLDER_TO_SEARCH
End If
' Start with the first file
file = Dir(cleanFolder)
' While the file list is not blank...
While (file <> "")
' By default we want to print
boolPrintMe = True
' If we find the keyword for a survey in there print the survey
If InStr(UCase(file), UCase(KEYWORD_SURVEY)) > 0 Then
' If we're using a confirmation prompt then let's prompt
If CONFIRMATION_PROMPT = True Then If MsgBox("Found a survey: " & file & "; continue?", vbYesNo) = vbNo Then boolPrintMe = False
' Increment a coun
filesFound = filesFound + 1
' Print the file
If boolPrintMe Then
' If we have anextention of .xls? then it's an Excel file and we need to
' note it
If InStr(UCase(file), UCase(".xls")) > 0 Then
Print_Survey CStr(cleanFolder & file), True
Else
Print_Survey CStr(cleanFolder & file), False
End If
End If
End If
' If we find the keyword for a RAMS document in there print the RAMS
If InStr(UCase(file), UCase(KEYWORD_RAMS)) > 0 Then
' Increment a counter
filesFound = filesFound + 1
' If we're using a confirmation prompt then let's prompt
If CONFIRMATION_PROMPT = True Then If MsgBox("Found a RAMS document: " & file & "; continue?", vbYesNo) = vbNo Then boolPrintMe = False
' Print the file
If boolPrintMe Then Print_RAMS (cleanFolder & file)
End If
' If we find the keyword for a test plan in there print the test plan
If InStr(UCase(file), UCase(KEYWORD_TESTPLAN)) > 0 Then
' Increment a counter
filesFound = filesFound + 1
' If we're using a confirmation prompt then let's prompt
If CONFIRMATION_PROMPT = True Then If MsgBox("Found a test plan: " & file & "; continue?", vbYesNo) = vbNo Then boolPrintMe = False
' Print the file
If boolPrintMe Then Print_TestPlan (cleanFolder & file)
End If
file = Dir
Wend
MsgBox "Files found: " & filesFound
End Sub
Function Print_TestPlan(strTestPlanName As String)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the test plan file, opens it in Excel and '
' then prints selected worksheets. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim wb As Workbook
Dim ws As Worksheet
' Turn of alerts momentarily so something doesn't freak out
Application.DisplayAlerts = True
' Open the workbook
Set wb = Application.Workbooks.Open(strTestPlanName)
' Print the first worksheet
' this is fucked Set ws = wb.Worksheets(1)
' this too ws.PrintOut
' Print the second worksheet
Set ws = wb.Worksheets(3)
With ws.PageSetup
.Orientation = xlLandscape
.PaperSize = xlPaperA3
End With
ws.PrintOut
' Close the document; don't save
wb.Close SaveChanges:=False
' Turn alerts back on
Application.DisplayAlerts = False
' Clean up
Set wb = Nothing
Set ws = Nothing
End Function
Function Print_Survey(strSurveyName As String, boolIsExcelFile As Boolean)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the survey file and whether or not it's '
' an Excel file. If it is an Excel file it goes through and prints a set '
' of selected pages; if not it just prints the whole document. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If it's an Excel file we treat it differently
If boolIsExcelFile = True Then
Dim wb As Workbook
Dim ws As Worksheet
Dim lngOrientation As Long
Dim lngPaperSize As Long
Dim boolPrintMe As Boolean
' Open the Survey workbook
Set wb = Workbooks.Open(strSurveyName)
' Parse through each worksheet
For Each ws In wb.Worksheets
' By default we want to print
boolPrintMe = True
' Look at the worksheet name; if it's one of the ones we want to print
' then set the orientation and paper size; otherwise do nothing
Select Case ws.Name
Case Is = "Title Sht "
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "Audit 1"
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "Audit 2"
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "Audit 3"
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "Audit 4"
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "Audit 5"
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "UU Provided information"
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "SES CDC"
lngOrientation = xlLandscape
lngPaperSize = xlPaperA4
Case Else
' If it's not one of the above then don't print
boolPrintMe = False
End Select
' If we want to print we just need to set the info
If boolPrintMe = True Then
' Set the orientation and paper size
With ws.PageSetup
.Orientation = lngOrientation
.PaperSize = lngPaperSize
End With
' Print it
ws.PrintOut
End If
' Go to the next worksheet
Next ws
' Close the survey but don't save it
wb.Close SaveChanges:=False
Else
' If it's anything else except an Excel document, we just print
ShellExecute 0, "Print", strSurveyName, vbNullString, "", SW_SHOWNORMAL
End If
End Function
Function Print_RAMS(strRAMSName As String)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the RAMS file and then prints it. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Call the Shell to execute the file
ShellExecute 0, "print", strRAMSName, vbNullString, "", SW_SHOWNORMAL
End Function
Function OLD_FUNCTION()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the RAMS file, opens an instance of Word, '
' changes the font color in the document and then prints it. Afterwards '
' it closes the document (without saving). '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim wd As Object
Dim doc As Object
Dim rng As Object
' Create instances of our Word Application and Document class
Set wd = CreateObject("Word.Application")
Set doc = CreateObject("Word.Document")
' Make Word visible, but turn off alerts
wd.Visible = True
wd.DisplayAlerts = wdAlertsNone
' Open the RAMS doc
Set doc = wd.Documents.Open(strRAMSName)
' Select the range, then turn all the fonts to black
Set rng = wd.ActiveDocument.Range
rng.wholestory
rng.Font.ColorIndex = wdBlack
' Print the document
doc.PrintOut
' Close the RAMS doc; don't save changes
doc.Close SaveChanges:=False
' Turn alerts back on and quit Word
wd.DisplayAlerts = wdAlertsAll
wd.Quit SaveChanges:=False
End Function
Display More
In access, I'm using debug print to check the value of the folder its searching and thats working. (this took me a few hours in itself) This is whats assigned to the button click.
ption Compare Database
Private Sub AddAppt_Click()
On Error GoTo AddAppt_Err
' Save record first to be sure required fields are filled.
DoCmd.RunCommand acCmdSaveRecord
' Exit the procedure if appointment has been added to Outlook.
If Me!AddedToOutLook = True Then
MsgBox "This appointment already added to Microsoft Outlook"
Exit Sub
' Add a new appointment.
Else
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem
Set outobj = CreateObject("outlook.application")
Set outappt = outobj.CreateItem(olAppointmentItem)
With outappt
.Start = Me!ApptDate & " " & Me!ApptTime
.Duration = Me!ApptLength
.Subject = Me!Appt
.Categories = "red;"
.AllDayEvent = True
If Not IsNull(Me!ApptNotes) Then .Body = Me!ApptNotes
If Not IsNull(Me!ApptLocation) Then .Location = _
Me!ApptLocation
If Me!ApptReminder Then
.ReminderMinutesBeforeStart = Me!ReminderMinutes
.ReminderSet = True
End If
.Save
End With
End If
' Release the Outlook object variable.
Set outobj = Nothing
' Set the AddedToOutlook flag, save the record, display a message.
Me!AddedToOutLook = True
DoCmd.SetWarnings False
DoCmd.RunCommand acCmdSaveRecord
DoCmd.OpenQuery "incriment visit"
DoCmd.SetWarnings True
MsgBox "Appointment Added!"
Exit Sub
AddAppt_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub
Private Sub Command46_Click()
Const FOLDER_TO_SEARCH = "[URL="file://\\SERVER\general\Installation\!ALL"]\\SERVER\general\Installation\!ALL[/URL] SITES"
Const KEYWORD_SURVEY = "survey"
Const KEYWORD_RAMS = "rams"
Const KEYWORD_TESTPLAN = "test"
Const CONFIRMATION_PROMPT = False
Dim SITE As Variant
Dim obj As Object
Dim MySource As Object
Dim file As Variant
Dim filesFound As Long
Dim cleanFolder As String
Dim boolPrintMe As Boolean
file = FOLDER_TO_SEARCH & Forms("frmAppointments NEW JOBS").Site_Name & ""
If file = False Then
Debug.Print "No SITE name selected."
Else
Debug.Print "One SITE selected: " & file
End If
' If there's not a trailing backslash add one
' If Right(FOLDER_TO_SEARCH, 1) <> "" Then
' cleanFolder = FOLDER_TO_SEARCH & ""
' Else
cleanFolder = file
' End If
' Start with the first file
file = Dir(cleanFolder)
' While the file list is not blank...
While (file <> "")
' By default we want to print
boolPrintMe = True
' If we find the keyword for a survey in there print the survey
If InStr(UCase(file), UCase(KEYWORD_SURVEY)) > 0 Then
' If we're using a confirmation prompt then let's prompt
If CONFIRMATION_PROMPT = True Then If MsgBox("Found a survey: " & file & "; continue?", vbYesNo) = vbNo Then boolPrintMe = False
' Increment a coun
filesFound = filesFound + 1
' Print the file
If boolPrintMe Then
' If we have anextention of .xls? then it's an Excel file and we need to
' note it
If InStr(UCase(file), UCase(".xls")) > 0 Then
Print_Survey CStr(cleanFolder & file), True
Else
Print_Survey CStr(cleanFolder & file), False
End If
End If
End If
' If we find the keyword for a RAMS document in there print the RAMS
If InStr(UCase(file), UCase(KEYWORD_RAMS)) > 0 Then
' Increment a counter
filesFound = filesFound + 1
' If we're using a confirmation prompt then let's prompt
If CONFIRMATION_PROMPT = True Then If MsgBox("Found a RAMS document: " & file & "; continue?", vbYesNo) = vbNo Then boolPrintMe = False
' Print the file
If boolPrintMe Then Print_RAMS (cleanFolder & file)
End If
' If we find the keyword for a test plan in there print the test plan
If InStr(UCase(file), UCase(KEYWORD_TESTPLAN)) > 0 Then
' Increment a counter
filesFound = filesFound + 1
' If we're using a confirmation prompt then let's prompt
If CONFIRMATION_PROMPT = True Then If MsgBox("Found a test plan: " & file & "; continue?", vbYesNo) = vbNo Then boolPrintMe = False
' Print the file
If boolPrintMe Then Print_TestPlan (cleanFolder & file)
End If
file = Dir
Wend
MsgBox "Files found: " & filesFound
End Sub
Function Print_TestPlan(strTestPlanName As String)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the test plan file, opens it in Excel and '
' then prints selected worksheets. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim wb As Workbook
Dim ws As Worksheet
' Turn of alerts momentarily so something doesn't freak out
Application.DisplayAlerts = True
' Open the workbook
Set wb = Application.Workbooks.Open(strTestPlanName)
' Print the first worksheet
Set ws = wb.Worksheets(1)
'
ws.PrintOut
' Print the second worksheet
Set ws = wb.Worksheets(3)
With ws.PageSetup
.Orientation = xlLandscape
.PaperSize = xlPaperA3
End With
ws.PrintOut
' Close the document; don't save
wb.Close SaveChanges:=False
' Turn alerts back on
Application.DisplayAlerts = False
' Clean up
Set wb = Nothing
Set ws = Nothing
End Function
Function Print_Survey(strSurveyName As String, boolIsExcelFile As Boolean)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the survey file and whether or not it's '
' an Excel file. If it is an Excel file it goes through and prints a set '
' of selected pages; if not it just prints the whole document. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If it's an Excel file we treat it differently
If boolIsExcelFile = True Then
Dim wb As Workbook
Dim ws As Worksheet
Dim lngOrientation As Long
Dim lngPaperSize As Long
Dim boolPrintMe As Boolean
' Open the Survey workbook
Set wb = Workbooks.Open(strSurveyName)
' Parse through each worksheet
For Each ws In wb.Worksheets
' By default we want to print
boolPrintMe = True
' Look at the worksheet name; if it's one of the ones we want to print
' then set the orientation and paper size; otherwise do nothing
Select Case ws.Name
Case Is = "Title Sht "
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "Audit 1"
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "Audit 2"
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "Audit 3"
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "Audit 4"
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "Audit 5"
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "UU Provided information"
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "SES CDC"
lngOrientation = xlLandscape
lngPaperSize = xlPaperA4
Case Else
' If it's not one of the above then don't print
boolPrintMe = False
End Select
' If we want to print we just need to set the info
If boolPrintMe = True Then
' Set the orientation and paper size
With ws.PageSetup
.Orientation = lngOrientation
.PaperSize = lngPaperSize
End With
' Print it
ws.PrintOut
End If
' Go to the next worksheet
Next ws
' Close the survey but don't save it
wb.Close SaveChanges:=False
Else
' If it's anything else except an Excel document, we just print
ShellExecute 0, "Print", strSurveyName, vbNullString, "", SW_SHOWNORMAL
End If
End Function
Function Print_RAMS(strRAMSName As String)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the RAMS file and then prints it. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Call the Shell to execute the file
ShellExecute 0, "print", strRAMSName, vbNullString, "", SW_SHOWNORMAL
End Function
Function OLD_FUNCTION()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the RAMS file, opens an instance of Word, '
' changes the font color in the document and then prints it. Afterwards '
' it closes the document (without saving). '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim wd As Object
Dim doc As Object
Dim rng As Object
' Create instances of our Word Application and Document class
Set wd = CreateObject("Word.Application")
Set doc = CreateObject("Word.Document")
' Make Word visible, but turn off alerts
wd.Visible = True
wd.DisplayAlerts = wdAlertsNone
' Open the RAMS doc
Set doc = wd.Documents.Open(strRAMSName)
' Select the range, then turn all the fonts to black
Set rng = wd.ActiveDocument.Range
rng.wholestory
rng.Font.ColorIndex = wdBlack
' Print the document
doc.PrintOut
' Close the RAMS doc; don't save changes
doc.Close SaveChanges:=False
' Turn alerts back on and quit Word
wd.DisplayAlerts = wdAlertsAll
wd.Quit SaveChanges:=False
DoCmd.OpenQuery "incriment printed"
End Function
Display More
Then this is module2 on the database:
Option Compare Database
Public Const SW_SHOWNORMAL As Long = 1
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Pike: I'm not 100% how this works but im assuming that value is uupdated when the keyword test is found in that folder.
Batman:
1. If thats not declared in the code shown here then no. I wish I could know the answer to the question you ask.
2. I thought exactally the same, but when it wasnt breaking I just left it like that.
3. I'm happy to use subs or any method if it works. This is what was supplied to me.
Note: Even leaving the code exactaly the same (without the folder search.. but with module2) the error remains in access.
Re: Method or data member not found
Anyone have any suggestions?
Compile error: Method or data member not found.
Function Print_TestPlan(strTestPlanName As String)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the test plan file, opens it in Excel and '
' then prints selected worksheets. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim wb As Workbook
Dim ws As Worksheet
' Turn of alerts momentarily so something doesn't freak out
Application.DisplayAlerts = True
' Open the workbook
Set wb = Application.Workbooks.Open(strTestPlanName)
' Print the first worksheet
' this is fucked
Set ws = wb.Worksheets(1)
' this too
ws.PrintOut
' Print the second worksheet
Set ws = wb.Worksheets(3)
With ws.PageSetup
.Orientation = xlLandscape
.PaperSize = xlPaperA3
End With
ws.PrintOut
' Close the document; don't save
wb.Close SaveChanges:=False
' Turn alerts back on
Application.DisplayAlerts = False
' Clean up
Set wb = Nothing
Set ws = Nothing
End Function
Function Print_Survey(strSurveyName As String, boolIsExcelFile As Boolean)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function takes the name of the survey file and whether or not it's '
' an Excel file. If it is an Excel file it goes through and prints a set '
' of selected pages; if not it just prints the whole document. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If it's an Excel file we treat it differently
If boolIsExcelFile = True Then
Dim wb As Workbook
Dim ws As Worksheet
Dim lngOrientation As Long
Dim lngPaperSize As Long
Dim boolPrintMe As Boolean
' Open the Survey workbook
Set wb = Workbooks.Open(strSurveyName)
' Parse through each worksheet
For Each ws In wb.Worksheets
' By default we want to print
boolPrintMe = True
' Look at the worksheet name; if it's one of the ones we want to print
' then set the orientation and paper size; otherwise do nothing
Select Case ws.Name
Case Is = "Title Sht "
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "Audit 1"
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "Audit 2"
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "Audit 3"
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "Audit 4"
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "Audit 5"
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "Provided information"
lngOrientation = xlPortrait
lngPaperSize = xlPaperA4
Case Is = "SES CDC"
lngOrientation = xlLandscape
lngPaperSize = xlPaperA4
Case Else
' If it's not one of the above then don't print
boolPrintMe = False
End Select
' If we want to print we just need to set the info
If boolPrintMe = True Then
' Set the orientation and paper size
With ws.PageSetup
.Orientation = lngOrientation
.PaperSize = lngPaperSize
End With
' Print it
ws.PrintOut
End If
' Go to the next worksheet
Next ws
' Close the survey but don't save it
wb.Close SaveChanges:=False
Else
' If it's anything else except an Excel document, we just print
ShellExecute 0, "Print", strSurveyName, vbNullString, "", SW_SHOWNORMAL
End If
End Function
Display More
Function Print_TestPlan(strTestPlanName As String) --- this is highlighted yellow
Application.DisplayAlerts = True --- this is highlighted blue
Ive messed about referencing the DAO object library instead of the access one. Nothing seems to resolve the issue.
The code I have shown does work for the survey but not the testplan. I have no idea what i can do to fix this now as I've looked at everything I can think of/have come accross searching the internet.
Could someone help me here?
This code does work "as is" when run through excel.
Thanks in advance
Andy
Re: Using multiple variables in VBA
Thanks for that. I know its easy, I can see now lol. This has helped me understand a bit more.
Re: Using multiple variables in VBA
I was concerned about the formatting. I didnt actually do this code Im a bit clueless, but ill have a play and post an update on monday. This is what i want to achieve but usually I just break code.
I have some code that imports calendar events to outlook.
I would like to include within the body text a variable or possibly multiple variables depending what information we recieve.
Heres the code:
Private Sub CreateAppointment(ws As Excel.Worksheet, lngRow As Long)
Dim oAppt As Object 'Outlook.AppointmentItem
Dim blnCreated As Boolean
Dim oFolder As Object 'Outlook.MAPIFolder
Dim lngAddRow As Long
Const olMeeting = 1
'On Error Resume Next
Set oFolder = oNS.GetDefaultFolder(&H9) ' olFolderCalendar
Set oAppt = oFolder.Items.Add(&H1) ' olAppointmentItem
Application.StatusBar = "Adding " & ws.Cells(lngRow, 1).Value
With oAppt
'Define calendar item properties
.Start = ws.Cells(lngRow, 7).Value + ws.Cells(lngRow, 8).Value
'.End = ws.Cells(lngRow, 7).Value + TimeValue("01:00:00")
.Subject = ws.Cells(lngRow, 1).Value
.Location = ws.Cells(lngRow, 6).Value
.AllDayEvent = True
.Body = "Hardwired signals: "
.BusyStatus = False
'.ReminderMinutesBeforeStart = ws.Cells(lngRow, 7).Value - TimeValue("00:30:00")
.ReminderSet = False
.Categories = shtImport.Range("CategoryName").Value
.MeetingStatus = olMeeting
.RequiredAttendees = "[EMAIL="[email protected]/"][email protected][/EMAIL].com"
.Send
.Save
End With
Set oAppt = Nothing
Set oFolder = Nothing
Exit Sub
ErrHandler:
'MsgBox "An error occurred - Exporting items to Calendar."
Display More
i want to change this:
I want to keep the .Body = "Hardwired signals: " but then also include information from cells next to it. (column I and J for example.)
I hope someone can help. Thanks.
Re: vba to send email
Bit of a long shot here but maybe you know. When it sends this way it comes on my calendar as accepted. but on the shared calendar its no response. If i click the send button myself it works on both.
Re: vba to send email
Thanks for the reply.
Sub AutoAcceptMeetings(oRequest As MeetingItem)
If oRequest.MessageClass <> "IPM.Schedule.Meeting.Request" Then
Exit Sub
End If
Dim oAppt As AppointmentItem
Set oAppt = oRequest.GetAssociatedAppointment(True)
Dim oResponse
Set oResponse = oAppt.Respond(olMeetingAccepted, True)
oResponse.display
oResponse.Send
End Sub
Display More
Apparently it does need to open first then send. Thanks for the help though
http://www.slipstick.com/outlo…ting-request-using-rules/
Im using the code here. Or specifically im using:
Sub AutoAcceptMeetings(oRequest As MeetingItem)
If oRequest.MessageClass <> "IPM.Schedule.Meeting.Request" Then
Exit Sub
End If
Dim oAppt As AppointmentItem
Set oAppt = oRequest.GetAssociatedAppointment(True)
Dim oResponse
Set oResponse = oAppt.Respond(olMeetingAccepted, True)
oResponse.Display
End Sub
Display More
Thats all well and good. But how do I send the response? haha
Re: VBA report generator
Anyone had a chance to look at this or have any questions?
forum.ozgrid.com/index.php?attachment/68251/
Hello,
I have a document we use for generating estimates for the customer, I want to automate some of the copy/pasting and the PDF creation.
As you can see in the attachment. The way this all works is fine, but im open to suggestions to improve it. The thing I need help with is the summery page. Where it says line 1, and line 1 cost breakdown, I want that information to be populated when a button is pushed.
*A "line" on the summery page represents a sheet in the document. 1/2/3 are examples of the sheets but they could be named anything.
* Information to be copied over is anything selected in the table, from columns B,C,D and J (these have the same title as the summery page.)
* Too add to confusion; there are two sections to the table. We have parts and Labour, all of these need to be copied over if there is a selection in that row. Using "Qty" column D could be a good check. Anything in this column with a value is what we want moved.
* I've just thought of this now, but moving cost index to sheet 2 could help (so it looks at sheet 3 onwards and this page doesn’t need to be excluded).
*where we have on the summery page "Line 1 Cost Breakdown" this can say "sheet name Cost Breakdown" (whatever that sheet name may be.
*We are not limited to three sheets, there may be a lot more. Once line one information is added i would like for it to add line 2 and so on.
I hope I've explained that clearly enough to get some advice. Or even better If someone has the time to put something together for me. I would be very greatful.
Thank you. Andy,
Re: Uploading incoming data to outlook calendar.
Its all good its working brilliant now pal. I appreciate what you have done.
Re: Uploading incoming data to outlook calendar.
It seemed your previous advice worked this time. I was able to remove that reference and add a reference to outlook 15 objects. Thanks for eveything!
Re: Uploading incoming data to outlook calendar.
[ATTACH=CONFIG]68135[/ATTACH]Hi mate, Sorry to be a pain but we have this error now. The image is a bit cut off there but it says: "compile error- cant find object or library". It seems its the same error in the refernces again.
Re: Uploading incoming data to outlook calendar.
when I uncheck the missing reference i click okay and open it again and its checked still. I can't find much about this, but ill keep looking.
Re: Uploading incoming data to outlook calendar.
Haha, the first page doesnt crash mate, that imports them within seconds. Thats what i was after, its the second page with apointments that crashes. Microsoft home and business 2013 is what im using, I should have said.
"microsoft outlook 16.0 object library" is missing, doing as you sugested didnt fix it. I'll google is a bit and see what i find. I spent a few hours trying to figure out why no VBA would work at all with outlook. Same on another machine im using, but after deleting a VBA file in outlook they seem to be working okay again.
Thanks for the help so far, Its crazy what you can do in half an hour.
Re: Uploading incoming data to outlook calendar.
Thanks a lot for that, the way I had it was making it cross over two days and was also showing time in the subject. This is a lot better than my attempt. Using the other code you gave, I was able to manipulate the categorys new sites went into. Now I get a message saying "Error in loading DLL". If you have done this to protect your code thats fine, but could you just change that category to 'red' that way its easy to see anything new for us to deal with.
Also i see you made a second page showing existing apointments, Its a good idea but when clicked outlook crashed. No error is shown. I dont mind not having this though.
thanks so far! its amazing haha.
EDIT: also having reminder set to none would be good. Or being able to see the options you gave me in the last one.